package gri_frontend;

use Cwd;
use Socket;
use File::Spec;
use File::Copy;
use File::Basename;
use Data::Dumper;
use Sys::Hostname;
use POSIX qw(strftime);
use JSON;
use gri_portal_config;
use gri_global_config;
use gri_database;
use gri_userprefs;
use gri_report_config;
use gri_roles_config;
use gri_conversions;
use gri_meta_report_config;
use gri_mime;
use gri_user_alert_config;
use gri2_requests;
use gri_macro_handler qw(hex_to_string string_to_hex);
use gri_secmgr qw(get_user_name);
use MIME::Base64;

my $error_str=undef;

sub error {
	return $error_str;
}

sub new {
my $self={};
my $class=shift;
my $global_config=shift;

	# Load in the global configuration object - and abort if	#
	# it has not been possible to parse.				#

	my $y=new gri_global_config($global_config);
	if(!defined($y)) {
		$error_str=gri_global_config::error();
		return undef;
	}
	if($y->get_port('authd_protocol')==1 ||
		$y->get_port('backend_protocol')==1) {
		# Security required so load in details if possible
		if(-e '../libs/gri2_rsatcp.pm') {
			push @INC,'../libs';
		}
		eval "use gri2_rsatcp;";
		if($@) {
			$error_str="Failed to load secure communication module:\n$@";
			return undef;
		}
		# Ok - load in ../authd-privkey or ./authd-privkey directory private
		# key if available, in $self->{authd_privkey} - set to undef if not here.
		# Might not be since only required on web server really.
		my ($a,$b)=(99,99);
		if(-e '../authd-privkey/authd.private') {
			($a,$b)=gri2_rsatcp::load_private_key({file=>'../authd-privkey/authd.private'});
		} elsif(-e 'authd-privkey/authd.private') {
			($a,$b)=gri2_rsatcp::load_private_key({file=>'authd-privkey/authd.private'});
		}
		if(! $a) {
			$error_str="Failed to load authd private key:\n";
			$error_str.="$_\n" foreach(@$b);
			return undef;
		}
		if($a==1) {
			$self->{authd_privkey}=$b;
		}
		if($a==99) {
			$error_str="Failed to determine authd private key to load.";
			return undef;
		}

		# The frontend will have a private key for each and every backend
		# that it needs to communicate with if secure communication is
		# in use.
		($a,$b)=(99,99);
		if(-d 'backend-privkeys') {
			($a,$b)=gri2_rsatcp::load_all_private_keys({dir=>'backend-privkeys'});
		} elsif(-d '../backend-privkeys') {
			($a,$b)=gri2_rsatcp::load_all_private_keys({dir=>'../backend-privkeys'});
		}
		if(! $a) {
			$error_str="Failed to load backend private keys:\n";
			$error_str.="$_\n" foreach(@$b);
			return undef;
		}
		if($a==1) {
			$self->{backend_privkeys}=$b;
		} 
		if($a==99) {
			$error_str="Failed to determine backend private keys to load.";
			return undef;
		}
	}

	#################################################################
	# Keep the necessary details for the configuration.		#
	#################################################################

	$self->{global_config}=$y;
	$self->{database}=undef;
	$self->{global_config_date}=time;
	$self->{global_config_file}=$global_config;

	$self->{auditdir}=$y->get_directory("auditdir");
	$self->{portals}=undef;
	$self->{portals_time}=0;

	my $reqdir=$y->get_directory("requests");
	if(!defined($reqdir)) {
		$reqdir="requests";
	}
	
	my $y2=new gri2_requests("$reqdir/requests.db");
	if(!defined($y2)) {
		$error_str="Unable to define gri2_requests object!";
		return undef;
	}
	$self->{gri2_requests}=$y2;
	$self->{reports}={};
	bless($self);
	return $self;
}

sub get_report_contents_from_query($$$) {
my $self=shift;
my $host=shift;
my $query=shift;

	my ($cline,$err)=query_backend($self,$host,$query);
	if(!defined($cline)) {
		return(undef,join("\n",@$err),undef);
	}
	my $off=index($cline,"\n");
	my $f1=substr($cline,0,$off);
	my $data=substr($cline,$off+1);
	my @FFF=split(/\s+/,$f1); 
	my $bytes=int($FFF[0]);
	my $rname;
	if(@FFF>1) {
		$rname=basename($FFF[1]);
	} else {
		$rname=undef;
	}
	return(\$data,undef,$rname);
}

sub std_audit_log_write($$$$) {
my $self=shift;
# Return a list of configured portals - we assume tha

	if(!defined($self->{auditdir})) {
		return;
	}
	my $fd;
	if(!defined($self->{auditfd})) {
		if(!open($fd,">>$self->{auditdir}/audit.log")) {
			return;
		}
		$self->{auditfd}=$fd;
	} else {
		$fd=$self->{auditfd};
	}
	my $type="STD";
	my $ip=$::ENV{REMOTE_ADDR};
	my ($user,$page,$args)=@_;
	my $ct=time;
	print $fd "$type|$ct|$ip|$user|$page|$args\n";
}

sub ext_audit_log_write($$$$$$) {
my $self=shift;
# Return a list of configured portals - we assume tha

	if(!defined($self->{auditdir})) {
		return;
	}
	my $fd;
	if(!defined($self->{auditfd})) {
		if(!open($fd,">>$self->{auditdir}/audit.log")) {
			return;
		}
		$self->{auditfd}=$fd;
	} else {
		$fd=$self->{auditfd};
	}
	my $type="EXT";
	my $ip=$::ENV{REMOTE_ADDR};
	my ($user,$status,$page,$args,$msg)=@_;
	my $ct=time;
	print $fd "$type|$ct|$ip|$user|$page|$args|$status|$msg\n";
}

sub get_portal_list {
my $self=shift;
my $user=shift;
my $as_struct=shift;
my @L=();
my @E=();

	$as_struct=0 if!defined($as_struct);
	my $user_access=1;
	$user_access=0 if !defined($user);
	$pd=$self->{global_config}->get_directory("portals");
	if(!defined($pd)) {
		if($as_struct) {
			return {
				error=>"No portal directory defined or available.",
				repinfo=>[],
			};
		}
		$error_str="No portal directory defined?";
		return undef;
	}
	
	if(! -d $pd) {
		if($as_struct) {
			return {
				error=>"Directory '$pd' does not exist.",
				repinfo=>[],
			};
		}
		$error_str="Directory '$pd' does not exist.";
		return undef;
	}
	if(! -r _) {
		if($as_struct) {
			return {
				error=>"Directory '$pd' is not readable.",
				repinfo=>[],
			};
		}
		$error_str="Directory '$pd' is not readable.";
		return undef;
	}

	my @s=stat(_);
	if(! defined($self->{portals}) ||
	 	$s[9] > $self->{portals_time}) {
		my $dfd;
		if(!opendir($dfd,$pd)) {
			if($as_struct) {
				return {
					error=>"Unable to read from directory '$pd'.",
					repinfo=>[],
				};
			}
			$error_str="Unable to read from directory '$pd'.";
			return undef;
		}
		my $dd;
		$self->{portals}=[];
		$self->{portal_names}={};
		$self->{portal_access}={};
		$self->{portal_fnames}={};
		$self->{portal_voters}={};
		$self->{portal_owners}={};
		$self->{portal_concur}={};
		$self->{portal_users}={}; # Users list for portal
		$self->{portal_reports}={}; # list of report names for each portal
		$self->{portal_mreports}={}; # list of meta report names for each portal
		$self->{portal_xml}={}; # Report count
		while($dd=readdir($dfd)) {
			if($dd =~ /^\./) {
				# ignore .dot files
				next;
			}
			if(-f "$pd/$dd" && -r _) {
				my $d=new gri_portal_config("$pd/$dd");
				next if !defined($d);
				push @{$self->{portals}},$d;
				my $t=$d->get_title();

				my $acc=0;
				my $pu=$d->get_users();
				my $po=$d->get_owners(); $po=[] if !defined($po);
				my $pv=$d->get_voters(); $pv=[] if !defined($pv);
				my $cc=$d->get_concur_count(); $cc=0 if !defined($cc);
				my $raw_xml=encode_base64($d->get_xml(),"");
				my $reps=$d->get_reports(0);
				my $mreps=$d->get_meta_reports(0);
				if($user_access) {
					$acc=0;
					if(defined($pu)) {
						$acc=1 if @$pu==0;
						if(grep {$user eq $_ || $_ eq "PUBLIC"} @$pu) {
							$acc=1;
						}
						if($acc==0) {
							my @groups=grep {$user =~ /^G:/} @$pu;
							for my $cg (@groups) {
								my ($rc,$users)=group_to_users($self,$cg);
								if($rc==1) {
									push @{$pu},@$users;
								}
							}
							if(@groups) {
								my @ul=grep {$_ !~ /^G:/} @$pu;
								$pu=[@ul];
								if(grep {$user eq $_} @$pu) {
									$acc=1;
								}
							}
						}
					}
				}
				$self->{portal_access}->{$t}=$acc;
				$self->{portal_users}->{$t}=[@{$pu}];
				$self->{portal_owners}->{$t}=[@{$po}];
				$self->{portal_voters}->{$t}=[@{$pv}];
				$self->{portal_reports}->{$t}=[@{$reps}];
				$self->{portal_concur}->{$t}=$cc;
				$self->{portal_mreports}->{$t}=[@{$mreps}];
				$self->{portal_names}->{$t}=$d;
				$self->{portal_xml}->{$t}=$raw_xml;

				my $fname=$dd; $fname =~ s/\.xml$//;
				$self->{portal_fnames}->{$t}=$t;
				$self->{portal_fnames2}->{$t}=$fname;
				push @L,$t;
			}
		}
		closedir($dfd);
		$self->{portals_time}=time;
	} else {
		@L=sort(keys(%{$self->{portal_names}}));
	}
	if($as_struct) {
		my @II=();
		for my $ckey (@L) {
			push @II,{
				portal => $ckey,
				name   => $self->{portal_fnames}->{$ckey},
				fname  => $self->{portal_fnames2}->{$ckey},
				access => $self->{portal_access}->{$ckey},
				reports => [@{$self->{portal_reports}->{$ckey}}],
				rcount => scalar(@{$self->{portal_reports}->{$ckey}}),
				mreports => [@{$self->{portal_mreports}->{$ckey}}],
				mrcount => scalar(@{$self->{portal_mreports}->{$ckey}}),
				users  => [@{$self->{portal_users}->{$ckey}}],
				owners  => [@{$self->{portal_owners}->{$ckey}}],
				voters  => [@{$self->{portal_voters}->{$ckey}}],
				ucount  => scalar(@{$self->{portal_users}->{$ckey}}),
				ocount  => scalar(@{$self->{portal_owners}->{$ckey}}),
				vcount  => scalar(@{$self->{portal_voters}->{$ckey}}),
				concur  => $self->{portal_concur}->{$ckey},
				admin  => 0, # Based on role and portal config....
				rawxml => $self->{portal_xml}->{$ckey},
			};
		}
		return {
			error => undef,
			repinfo => [@II],
		}
	}
	return [@L];
}

sub get_portal_filename {
my $self=shift;
my $portal=shift;

	get_portal_list($self);
	if(exists($self->{portal_fnames2}->{$portal})) {
		return $self->{portal_fnames2}->{$portal};
	}
	return "";
}

sub delete_report {
my $self=shift;
my $report=shift;

	my $pd=$self->{global_config}->get_directory("reports");
	my $f="$pd/$report.xml";
	if(! $f) {
		return(0,"Failed to find file '$f'.");
	}
	if(! unlink($f)) {
		return(0,"Failed to delete file '$f'.");
	}
	return(1,undef);
}

sub delete_portal_by_name {
my $self=shift;
my $portal=shift;

	if(!defined(get_portal_list($self))) {
		return(0,$error_str);
	};
	if(exists($self->{portal_fnames2}->{$portal})) {
		my $pd=$self->{global_config}->get_directory("portals");
		if($pd && -d $pd) {
			my $f="$pd/" . $self->{portal_fnames2}->{$portal} . '.xml';
			if(-f $f) {
				if(unlink($f)) {
					return(1,undef);
				}
			} else {
				return(0,"Missing file '$f'.");
			}
		} else {
			return(0,"Missing directory '$pd'.");
		}
	} else {
		return(0,"Portal '$portal' not found.");
	}
}

sub duplicate_portal_by_name {
my $self=shift;
my $portal=shift;

	if(!defined(get_portal_list($self))) {
		return(0,$error_str);
	};
	if(exists($self->{portal_fnames2}->{$portal})) {
		my $pd=$self->{global_config}->get_directory("portals");
		if($pd && -d $pd) {
			my $f="$pd/" . $self->{portal_fnames2}->{$portal} . '.xml';
			my $ff;
			if(-f $f) {
				# Found portal, so work out copy name...
				my $cc=1;
				my $bn=$f; $bn =~ s/\.xml$//;
				while(1) {
					$ff="${bn}_dup${cc}.xml";
					if(! -f $ff) {
						last;
					}
					$cc++;
				}
				# so cc is the duplicate number and $ff is full path
				if(!copy($f,$ff)) {
					return(0,"Failed to generate file '$ff' by copying '$f'.");
				}
				# Load in copy, change text and write out...
				my $new_one=new gri_portal_config($ff);
				my $title=$new_one->get_title();
				$title =~ s/^Copy #\d+\S+//;
				$new_one->set_title("Copy #${cc} of $title");
				my ($rc,$errmsg)=$new_one->write_file($ff);
				return ($rc,$errmsg);
			} else {
				return(0,"Missing file '$f'.");
			}
		} else {
			return(0,"Missing directory '$pd'.");
		}
	} else {
		return(0,"Portal '$portal' not found.");
	}
}

sub duplicate_report {
my $self=shift;
my $report=shift;

	my $pd=$self->{global_config}->get_directory("reports");
	my $f="$pd/$report.xml";
	$x=new gri_report_config($f);
	# Unable to load the report so return this fact
	if(!defined($x)) {
		my $e=gri_report_config::error();
		return(0,$e);
	}
	# Found report, so work out copy name...
	my $cc=1;
	my $ff;
	my $bn=$f; $bn =~ s/\.xml$//;
	while(1) {
		$ff="${bn}_dup${cc}.xml";
		if(! -f $ff) {
			last;
		}
		$cc++;
	}
	# so cc is the duplicate number and $ff is full path
	if(!copy($f,$ff)) {
		return(0,"Failed to generate file '$ff' by copying '$f'.");
	}
	# Load in copy, change text and write out...
	my $new_one=new gri_report_config($ff);
	my $title=$new_one->get_title();
	$title =~ s/^Copy #\d+\S+//;
	$new_one->set_title("Copy #${cc} of $title");
	my $errmsg=$new_one->write_file($ff);
	if(defined($errmsg)) {
		return(0,$errmsg);
	}
	return (1,undef);
}

sub get_portal_meta_report_names {
my $self=shift;
my $portal=shift;
my $get_names=shift;

	$get_names=0 if(!defined($get_names));
	get_portal_list($self);
	if(!exists($self->{portal_names}->{$portal})) {
		print STDERR "No details for portal '$portal' found!\n";
	}
	return(undef) if !exists($self->{portal_names}->{$portal});
	if(!$get_names) {
		return $self->{portal_names}->{$portal}->get_meta_reports();
	}
	my $F=$self->get_portal_meta_report_names($portal);
	my @R=();
	my ($cname,$ctype,$chost_list,$e1);
	for my $crep (@{$F}) {
		($cname,$e1)=get_meta_report_name($self,$crep);
		if(!defined($e1)) {
			($ctype,$e1)=get_meta_report_type($self,$crep);
			($chost_list,$e1)=get_meta_report_host($self,$crep); # or host list if multiple!!
		}
		$ctype="?unknown?" if !defined($ctype);
		if(!defined($cname)) {
			$cname=$crep;
		}
		if(!defined($e1)) {
				push @R,{report=>$crep,name=>$cname,type=>$ctype,host=>$chost_list,error=>undef};
		} else {
				push @R,{report=>$crep,name=>undef,type=>undef,host=>undef,error=>$e1};
		}
	}
	return ["OK",@R];
}

sub get_portal_report_names {
my $self=shift;
my $portal=shift;
my $get_names=shift;

	$get_names=0 if(!defined($get_names));
	get_portal_list($self);
	if(!exists($self->{portal_names}->{$portal})) {
		print STDERR "No details for portal '$portal' found!\n";
	}
	return(undef) if !exists($self->{portal_names}->{$portal});
	if(!$get_names) {
		return $self->{portal_names}->{$portal}->get_reports();
	}
	my $F=$self->{portal_names}->{$portal}->get_reports();
	my @R=();
	my ($cname,$ctype,$chost,$e1);
	for my $crep (@{$F}) {
		($cname,$e1)=get_report_name($self,$crep);
		# Once you've got the title, things are more complex for the 
		# meta reports, so might just return the names for now!!

		if(!defined($e1)) {
			($ctype,$e1)=get_report_type($self,$crep);
			($chost,$e1)=get_report_host($self,$crep);
		}
		$ctype="?unknown?" if !defined($ctype);
		if(!defined($cname)) {
			$cname=$crep;
		}
		if(!defined($e1)) {
				push @R,{report=>$crep,name=>$cname,type=>$ctype,host=>$chost,error=>undef};
		} else {
				push @R,{report=>$crep,name=>undef,type=>undef,host=>undef,error=>$e1};
		}
	}
	return ["OK",@R];
}

sub get_portal_details {
my $self=shift;
my $portal=shift;

	my %e=(
			filename => undef,
			error => undef,
			users => [],
			reports => [],
			meta_reports => [],
			title => undef,
			template => undef,
			owners => [],
			voters => [],
			concur_count => 0,

	);
	get_portal_list($self);
	if(!exists($self->{portal_names}->{$portal})) {
		$e{error} = "No details for portal '$portal' found!";
		return {%e};
	}
	
	# Populate the available details...
	my $hr = $self->{portal_names}->{$portal}->get_details();
	for my $c (keys %$hr) {
		$e{$c}=$hr->{$c};
	}
	return {%e};
}

sub get_portal_users {
my $self=shift;
my $portal=shift;
my $expand=shift;

	$expand=1 if !defined($expand);
	get_portal_list($self);
	if(!exists($self->{portal_names}->{$portal})) {
		print STDERR "No details for portal '$portal' found!\n";
	}
	return(undef) if !exists($self->{portal_names}->{$portal});
	return $self->{portal_names}->{$portal}->get_users();
}

sub set_portal_users {
my $self=shift;
my $portal=shift;
my $users=shift;

	get_portal_list($self);
	if(!exists($self->{portal_names}->{$portal})) {
		return (0,"No details for portal '$portal' found!");
	}
	return(0,"Portal details not found for portal '$portal'.") if !exists($self->{portal_names}->{$portal});
	$self->{portal_names}->{$portal}->set_users($users);
	my ($rc,$err)=$self->{portal_names}->{$portal}->write_file();
	return($rc,$err);
}

sub add_portal_users {
my $self=shift;
my $portal=shift;
my $users=shift;

	get_portal_list($self);
	if(!exists($self->{portal_names}->{$portal})) {
		return (0,"No details for portal '$portal' found!");
	}
	return(0,"Portal details not found for portal '$portal'.") if !exists($self->{portal_names}->{$portal});
	my $current_users=$self->{portal_names}->{$portal}->get_users();
	for my $cu (@$users) {
		if(! grep {$cu eq $_} @{$current_users}) {
			push @{$current_users},$cu;
		}
	}
	$self->{portal_names}->{$portal}->set_users($current_users);
	my ($rc,$err)=$self->{portal_names}->{$portal}->write_file();
	return($rc,$err);
}

sub does_portal_exist($$) {
my $self=shift;
my $portal=shift;

	get_portal_list($self);
	return(0) if !exists($self->{portal_names}->{$portal});
	return 1;
}

sub is_user_allowed {
my $self=shift;
my $portal=shift;
my $user=shift;

	get_portal_list($self);
	return(0) if !exists($self->{portal_names}->{$portal});
	my $link=$self->{portal_names}->{$portal}->get_users();
	# return(1) if !defined($link);
	# return(1) if @$link==0;
	if(grep {$user eq $_ || $_ eq "PUBLIC"} @$link) {
		return(1);
	}
	$link=$self->expand_groups($link);
	if(grep {$user eq $_} @$link) {
		return(1);
	}
	return(0);
}

sub expand_groups {
my $self=shift;
my $u=shift;

	my @N=();
	for my $cu (@$u) {
		if(substr($cu,0,2) ne "G:") {
			push @N,$cu; next;
		}
		my ($rc,$l)=$self->group_to_users($cu);
		if($rc==1) {
			push @N,@$l;
		}
	}
	return [@N];
}
sub _get_client_sock($$) {
my ($host,$port)=@_;

	my $iaddr = inet_aton($host) || return(undef,"Unable to resolve hostname: $!");
	my $paddr = sockaddr_in($port, $iaddr);
	my $proto = getprotobyname('tcp');
	my $fd;
	socket($fd,PF_INET,SOCK_STREAM,$proto) || return(undef,"Unable to create socket: $!");
	connect($fd, $paddr) || return (undef,"Unable to connect to server '$host': $!");
	my $x=select($fd);
	$|=1;
	select($x);
	return ($fd,undef);
}

#########################################################################
# This will query the report if possible - and will return the 		#
# following information:						#
# 1 - the title of the report, 2 - host of the report, 			#
# 3 - latest report date, 4 - latest report size, 5 - type, 		#
# 6 - count of reports							#
#									#
# If an error occurs then instead it will return:			#
# undef,undef,undef,undef,undef,error_msg				#
#########################################################################

sub get_portal_report_details {
my $self=shift;
my $portal=shift; # Can by __DUMMY__
my $report=shift;
my $struct=shift;

	$struct=0 if !defined($struct);
	get_portal_list($self);
	if($portal eq "dummy" || $portal eq "__DUMMY__") {
		if($struct) {
			return {
				report => $report,
				portal => $portal,
				display_name => undef,
				title => undef,
				host => undef,
				date => undef,
				size => undef,
				type => undef,
				count => undef,
				attrs => undef,
				rawxml => undef,
				dynamic => undef,
				error => "No portal '$portal' exists"
			};
		}
	}

	#################################################################
	# Ok the portal exists, so we check to load in the report	#
	# details, and abort if we can not.				#
	#################################################################

	my $x;
	if(!exists($self->{reports}->{$report})) {
		my $pd=$self->{global_config}->get_directory("reports");
		$x=new gri_report_config("$pd/$report.xml");
		if(!defined($x)) {
			my $e=gri_report_config::error();
			if($struct) {
				return {
					report => $report,
					portal => $portal,
					title => undef,
					display_name => undef,
					host => undef,
					date => undef,
					size => undef,
					type => undef,
					count => undef,
					rawxml => undef,
					attrs => undef,
					dynamic => undef,
					error => $e
				};
			}
			return(undef,undef,undef,undef,undef,$e,undef,undef,undef,undef);
		}
		$self->{reports}->{$report}=$x;
	} else {
		$x=$self->{reports}->{$report};
	}

	my $raw_xml=encode_base64($x->get_xml(),"");
	#################################################################
	# Now we get the title and host of the report...		#
	#################################################################

	my ($title,$host,$date,$size,$type,$count)=("?title?","?host?","?date?",0,"No Reports",0);

	$title=$x->get_title;
	$host=$x->get_host;
	$dir=$x->get_directory;
	$name=$x->get_name;
	$type=$x->get_type;
	my $display_name=$x->get_display_name;
	my @dyn=$x->get_dynamic_info;
	$attrs=$x->get_attributes;

	my ($cline,$a,$b);
	if($struct) {
		($a,$b)=query_backend($self,$host,"GET_LATEST_REPORT_WITH_STORAGE DIR=$dir NAME=$name\n");
	} else {
		($a,$b)=query_backend($self,$host,"GET_LATEST_REPORT DIR=$dir NAME=$name\n");
	}
	if(!defined($a)) {
		$cline="ERROR ".join("\n",@$b);
		if($struct) {
			return {
				report => $report,
				portal => $portal,
				display_name => undef,
				title => undef,
				host => undef,
				date => undef,
				directory => undef,
				size => undef,
				type => undef,
				count => undef,
				attrs => undef,
				rawxml => undef,
				dynamic => undef,
				error => $cline,
			};
		}
		return(undef,undef,undef,undef,undef,$cline,undef,undef,undef,undef);
	}
	$cline=$a;
	if($cline =~ /ERROR/) {
		if($struct) {
			return {
				report => $report,
				portal => $portal,
				display_name => undef,
				title => undef,
				host => undef,
				date => undef,
				directory => undef,
				pattern => $name,
				size => undef,
				type => undef,
				count => undef,
				attrs => undef,
				rawxml => undef,
				dynamic => undef,
				error => $cline,
			};
		}
		return(undef,undef,undef,undef,undef,$cline,undef,undef,undef,undef);
	}
	chomp $cline;
	if($cline eq "__NO_REPORTS__") {
		if($struct) {
			return {
				report => $report,
				portal => $portal,
				display_name => $display_name,
				title => $title,
				host => $host,
				date => "",
				directory => $dir,
				pattern => $name,
				size => 0,
				type => $type,
				count => 0,
				attrs => $attrs,
				rawxml => $raw_xml,
				dynamic => [@dyn],
				error => undef,
			};
		}
		return($title,$host,"",0,$type,0,@dyn,$attrs);
	}
	my @i=split(/\|/,$cline);
	my @DD=split(/\./,$i[3]); if($DD[0]<1000) {$DD[0]+=2000;}
	$date=sprintf("%04d.%02d.%02d",@DD);
	$size=$i[5]; $count=$i[4];
	if($struct) {
		return {
			report => $report,
			portal => $portal,
			title => $title,
			display_name => $display_name,
			host => $host,
			date => $date,
			directory => $dir,
			pattern => $name,
			size => $size,
			type => $type,
			rawxml => $raw_xml,
			count => $count,
			attrs => $attrs,
			dynamic => [@dyn],
			error => undef,
		};
	}
	return($title,$host,$date,$size,$type,$count,@dyn,$attrs,$dir,$name);
}

sub _add_in_portal {
my $self=shift;
my $rep_ref=shift;
my $portal=shift;

	# Get a list of normal and meta report filenames for the portal...
	my $portal_dir=$self->{global_config}->get_directory("portals");
	return if !defined($portal_dir);

	for my $xx (@$rep_ref) {
		$xx->{included}=0;
	}
	if($portal !~ /\.xml$/) {
		$portal.='.xml';
	}
	# Open the portal in question and retrieve list of reports/meta reports...
	my $d=new gri_portal_config("$portal_dir/$portal");
	my $portal_reps=$d->get_reports();
	my $portal_mreps=$d->get_meta_reports();

	for my $crep (@$portal_reps) {
		for my $xx (@$rep_ref) {
			if($xx->{reptype} ne 'M' && $xx->{filename} eq $crep) {
				$xx->{included}=1; last;
			}
		}
	}
	for my $crep (@$portal_mreps) {
		for my $xx (@$rep_ref) {
			if($xx->{reptype} eq 'M' && $xx->{filename} eq $crep) {
				$xx->{included}=1; last;
			}
		}
	}
}

# Return basic report details, with those for meta-reports
# optionally, and also an indicated if included if a 
# specified portal (also optional!)

sub get_all_reports_basic_details {
my $self=shift;
my $include_metas=shift;
my $in_portal=shift;

	$include_metas||=0;
	if(defined($in_portal)) {
		$in_portal=get_portal_filename($self,$in_portal);
	}

	my @warnings=();
	my @rep_info=();
	my $rep_dir=$self->{global_config}->get_directory("reports");
	my $mrep_dir;
	if($include_metas) {
		$mrep_dir=$self->{global_config}->get_directory("meta_reports");
	}
	if(!defined($rep_dir)) {
		return {
			error => "Missing reports directory definition.",
			warnings => [@warnings],
			reports => []
		};
	}
	if($include_metas && !defined($mrep_dir)) {
		push @warnings,"Directory 'meta_reports' directory definition.";
		$include_metas=0;
	}
	my ($dfd,$cr);
	if(!opendir($dfd,$rep_dir)) {
		return {
			error => "Unable to open directory '$rep_dir'.",
			warnings => [@warnings],
			reports => []
		};
	}
	while($cr=readdir($dfd)) {
		next if $cr !~ /\.xml$/;
		# Read in the report details (no backend queries though)
		my $x=new gri_report_config("$rep_dir/$cr");
		if(!defined($x)) {
			my $e=gri_report_config::error();
			push @warnings,$e;
			next;
		}
		my $v=$x->get_details2();
		$cr =~ s/\.xml$//;
		$v->{xmlfile}=$cr;
		$v->{raw_xml}=$x->get_xml();
		push @rep_info,$v;
	}
	closedir($dfd);

	if($include_metas) {
		my ($dfd,$cr);
		if(!opendir($dfd,$mrep_dir)) {
			push @warnings,"Unable to open directory '$mrep_dir'.";
			if(defined($in_portal)) {
				_add_in_portal($self,\@rep_info,$in_portal);
			}
			return {
				error => undef,
				warnings => [@warnings],
				reports => [@rep_info]
			};
		}
		while($cr=readdir($dfd)) {
			next if $cr !~ /\.xml$/;
			# Read in the meta-report details (no backend queries though)
			my $x=new gri_meta_report_config("$mrep_dir/$cr");
			if(!defined($x)) {
				my $e=gri_meta_report_config::error();
				push @warnings,$e;
				next;
			}
			my $v=$x->get_details2();
			$cr =~ s/\.xml$//;
			$v->{xmlfile}=$cr;
			push @rep_info,$v;
		}
		closedir($dfd);
	}
	if(defined($in_portal)) {
		_add_in_portal($self,\@rep_info,$in_portal);
	}
	return {
		error => undef,
		warnings => [@warnings],
		reports => [@rep_info]
	};
}

# Since the javascript interface pages in reports we might not have#
# all details and hence this is an incremental update.
#

sub update_portal_reports {
my $self=shift;
my $pname=shift;
my $updated=shift;
my $updated_users=shift;

	$portal=get_portal_filename($self,$pname);

	my $portal_dir=$self->{global_config}->get_directory("portals");
	if(!defined($portal_dir)) {
		return {
			error => "Unable to find 'portals' setting in configuration"
		};
	}
	if($portal !~ /\.xml$/) {
		$portal.='.xml';
	}
	my $d=new gri_portal_config("$portal_dir/$portal");
	my $e_portal_users=$d->get_users();
	my $e_portal_reps=$d->get_reports();
	my $e_portal_mreps=$d->get_meta_reports();

	# We alter the list of users based on the contents of the
	# updated_users array of hash information...

	my $changes=0;
	my @N3=@$e_portal_users;
	for my $c (@$updated_users) {
		my $uid=$c->{uid};
		if($c->{included}==1) {
			# Selected so add to user list if not currently present
			if(! grep {$_ eq $uid} @N3) {
				push @N3,$uid;
				$changes=1;
			}
		} else {
			# Not selected so remove from user list if currently present
			if(grep {$_ eq $uid} @N3) {
				@N3=grep {$_ ne $uid} @N3;
				$changes=1;
			}
		}
	}

	# Search through the updates adding/taking away reports...

	my @N=@$e_portal_reps;
	my @N2=@$e_portal_mreps;
	for my $c (@$updated) {
		my $fname=$c->{filename};
		if($c->{selected}==1) {
			# Selected so add to report list if not currently present
			if($c->{reptype} ne "M") {
				if(! grep {$_ eq $fname} @N) {
					push @N,$fname;
					$changes=1;
				}
			} else {
				if(!grep {$_ eq $fname} @N2) {
					push @N2,$fname;
					$changes=1;
				}
			}
		} else {
			# Not selected so remove from report list if currently present
			if($c->{reptype} ne "M") {
				if(grep {$_ eq $fname} @N) {
					@N=grep {$_ ne $fname} @N;
					$changes=1;
				}
			} else {
				if(grep {$_ eq $fname} @N2) {
					@N2=grep {$_ ne $fname} @N2;
					$changes=1;
				}
			}
		}
	}

	# Re-write the file if there have been any changes ...
	if(! $changes) {
		return {
			error => undef
		};
	}

	$d->set_reports([@N]);
	$d->set_meta_reports([@N2]);
	$d->set_users([@N3]);
	my ($success,$errormsg)=$d->write_file();
	if(!$success) {
		return {
			error => $errormsg
		};
	}
	return { error => undef };
}

#########################################################################
# Passed in the portal, but we do not need to use it. Return details	#
# of all reports as a reference to a string. We use the report object	#
# to connect remotely and drag the details from the backend using the	#
# GET_REPORT_LIST DIR=/dir NAME=name [OLDEST=n]				#
#########################################################################

sub get_all_reports {
my $self=shift;
my $portal=shift;
my $report=shift;
my $oldest=shift;
my $ashash=shift;

	$oldest=0 if !defined($oldest);
	$ashash=0 if !defined($ashash);
	my $x;
	if(!exists($self->{reports}->{$report})) {
		my $pd=$self->{global_config}->get_directory("reports");
		$x=new gri_report_config("$pd/$report.xml");
		if(!defined($x)) {
			my $e=gri_report_config::error();
			if($ashash) {
				return {
					error =>$e,
					records => [],
					count => 0,
				}
			}
			return(undef,$e);
		}
		$self->{reports}->{$report}=$x;
	} else {
		$x=$self->{reports}->{$report};
	}
	my $host=$x->get_host;
	my $dir=$x->get_directory;
	my $name=$x->get_name;
	my ($a,$b);
	if($oldest) {
		($a,$b)=query_backend($self,$host,"GET_REPORT_LIST DIR=$dir NAME=$name OLDEST=$oldest\n");
	} else {
		($a,$b)=query_backend($self,$host,"GET_REPORT_LIST DIR=$dir NAME=$name\n");
	}
	if(!defined($a)) {
		if($ashash) {
			return {
				error =>join("\n",@$b),
				records => [],
				count => 0,
			}
		}
		return(undef,join("\n",@$b));
	}
	$cline=$a;
	if($cline =~ /ERROR/) {
		if($ashash) {
			return {
				error =>$cline,
				records => [],
				count => 0,
			}
		}
		return(undef,$cline);
	}
	chomp $cline;
	if($ashash) {
		my @R=split(/\|/,$cline);
		my %h=(error => undef, count => $R[0]);
		my @recs=();
		my $c=1; my $rc=0;
		while ($rc<$R[0]) {
			push @recs,{
				fname => $R[$c],
				fsize => $R[$c+1],
				fmtime => $R[$c+2],
				fdate_str => $R[$c+3]
			};
			++$rc;
			$c+=4;
		}
		return {
			error => undef,
			count => $R[0],
			records => [@recs]
		}
	}
	return(\$cline,undef);
}

# Given a meta report return a list of files from the matching
# sub-report (first one being 0).
# If instance_data==1 then oldest is data of report content to retrieve.

sub get_all_reports_for_meta_report_nn {
my $self=shift;
my $portal=shift;
my $meta_report=shift;
my $meta_report_instance=shift;
my $oldest=shift;
my $ashash=shift;
my $instance_data=shift;

	$oldest=0 if !defined($oldest);
	$ashash=0 if !defined($ashash);
	$instance_data=0 if !defined($instance_data);

	my $x;
	if(!exists($self->{meta_reports}->{$meta_report})) {
		my $pd=$self->{global_config}->get_directory("meta_reports");
		$x=new gri_meta_report_config("$pd/$meta_report.xml");
		if(!defined($x)) {
			my $e=gri_meta_report_config::error();
			if($ashash) {
				return {
					error =>$e,
					records => [],
					count => 0,
				}
			}
			return(undef,$e);
		}
		$self->{meta_reports}->{$meta_report}=$x;
	} else {
		$x=$self->{meta_reports}->{$meta_report};
	}
	my $reports_count=$x->get_report_count();
	# Check the report number is less than the number 
	# of defined reports in the meta-report.
	if($meta_report_instance>=$reports_count) {
			if($ashash) {
				return {
					error => "Report number $meta_report_instance is too large ($reports_count defined)",
					records => [],
					count => 0,
				}
			}
			return(undef,"Report number $meta_report_instance is too large ($reports_count defined)");
	}

	# Get the sub-report details and query the server in question
	my $rep_info=$x->get_report_info($meta_report_instance);

	my $host=$rep_info->{host};
	my $dir=$rep_info->{directory};
	my $name=$rep_info->{name};
	if($instance_data) {
		my ($a,$err,$rname)=get_report_contents_from_query($self,$host,"GET_REPORT_CONTENTS DIR=$dir NAME=$name MTIME=$oldest\n");
		if(!defined($a)) {
			if($ashash) {
				return {
					error =>join("\n",@$err),
					records => [],
					count => 0,
				}
			}
			return(undef,$err);
		}
		return(\$a,undef,$rname);
	}
	my ($a,$b,$cline);
	if($oldest) {
		($a,$b)=query_backend($self,$host,"GET_REPORT_LIST DIR=$dir NAME=$name OLDEST=$oldest\n");
	} else {
		($a,$b)=query_backend($self,$host,"GET_REPORT_LIST DIR=$dir NAME=$name\n");
	}
	if(!defined($a)) {
		$cline="ERROR ".join("\n",@$b);
	} else {
		$cline=$a;
	}
	if($cline =~ /ERROR/) {
		if($ashash) {
			return {
				error =>$cline,
				records => [],
				count => 0,
			}
		}
		return(undef,$cline);
	}
	chomp $cline;
	if($ashash) {
		my @R=split(/\|/,$cline);
		my %h=(error => undef, count => $R[0]);
		my @recs=();
		my $c=1; my $rc=0;
		while ($rc<$R[0]) {
			push @recs,{
				fname => $R[$c],
				fsize => $R[$c+1],
				fmtime => $R[$c+2],
				fdate_str => $R[$c+3]
			};
			++$rc;
			$c+=4;
		}
		return {
			error => undef,
			count => $R[0],
			records => [@recs]
		}
	}
	return(\$cline,undef);
}

sub get_report_contents_by_mtime($$$$) {
my $self=shift;
my $portal=shift;
my $report=shift;
my $repmtime=shift;

	my $err=undef;
	my ($fd,$x);
	if(!exists($self->{reports}->{$report})) {
		my $pd=$self->{global_config}->get_directory("reports");
		$x=new gri_report_config("$pd/$report.xml");
		if(!defined($x)) {
			my $e=gri_report_config::error();
			return(undef,$e);
		}
		$self->{reports}->{$report}=$x;
	} else {
		$x=$self->{reports}->{$report};
	}

	my $host=$x->get_host;
	my $dir=$x->get_directory;
	my $name=$x->get_name;
	my ($a,$rname);
	($a,$err,$rname)=get_report_contents_from_query($self,$host,"GET_REPORT_CONTENTS DIR=$dir NAME=$name MTIME=$repmtime\n");
	if(!defined($a)) {
		return(undef,join("\n",@$err));
	}
	return(\$a,undef,$rname);
}

sub get_meta_report_contents_by_mtime($$$$$$) {
my $self=shift;
my $portal=shift;
my $meta_report=shift;
my $crep=shift;
my $repmtime=shift;
my $rdate=shift;

		my ($res,$junk1,$junk2)=filter_meta_reports($self,$portal,$meta_report,0,[$repmtime,$rdate]);
		return $res;
}

# This routine uses the above to grab out the report names assoicated with all
# sub-reports. It then applies local filtering. For example if the meta-info
# contains "<sort>date</sort> it will sort all records for each sub-report
# by date (newest first).
#
# if the meta-info contains a "<group_by>" clause it will add array information
# for grouping the records in this manner. For example if "group_by" was day:monday 
# then the meta-summary settings would be a list of keys/members for each monday.
# For example meta-info->[report_number]->{mondayNN}->[recs]
#
# Each [recs] is fname,fszize,fmtime,fdate_str for each sub-report - first being the
# group_by report itself.
#
# If get_content is defined, then it defines the 'head' of the report to get.
#

sub filter_meta_reports($$$;$$) {
my $self=shift;
my $portal=shift;
my $meta_report=shift;
my $oldest=shift;
my $get_content=shift;

	$oldest=0 if !defined($oldest);
	my $get_content_repmtime=undef;
	my $get_content_rdate=undef;
	if(defined($get_content) && ref($get_content)) {
		$get_content_repmtime=$get_content->[0];
		$get_content_rdate=$get_content->[1];
	}

	my $x;
	if(!exists($self->{meta_reports}->{$meta_report})) {
		my $pd=$self->{global_config}->get_directory("meta_reports");
		$x=new gri_meta_report_config("$pd/$meta_report.xml");
		if(!defined($x)) {
			my $e=gri_meta_report_config::error();
			return(undef,$e);
		}
		$self->{meta_reports}->{$meta_report}=$x;
	} else {
		$x=$self->{meta_reports}->{$meta_report};
	}
	my $reports_count=$x->get_report_count();
	my @ALL_REPORTS=();
	for my $crep (0 .. $reports_count-1) {
		my $h=get_all_reports_for_meta_report_nn($self,$portal,$meta_report,$crep,$oldest,1,0);
		if(defined($get_content_rdate)) {
			my $rep_info=$x->get_report_info($crep);
			my ($_x1,$_x2,$_x3)=get_report_contents_by_host_dir_name_mtime($self,$rep_info->{host},
				$rep_info->{directory},$rep_info->{name},$get_content_repmtime);
				$h->{content}=$$_x1;
		}
		push @ALL_REPORTS,{%$h,report => $meta_report, rawxml=>encode_base64($x->get_xml(),"")};
	}
	my $mi=$x->get_meta_info();
	# Return the basic details if no group_by mechanism is provided.
	if(!exists($mi->{group_by}) || !defined($mi->{group_by}) || !length($mi->{group_by})) {
		return ([@ALL_REPORTS],undef);
	}
	# All the report information across all sub-reports has been
	# gathered, so get meta-attributes now...
	$mi = $x->get_meta_info();
	my $sort="date";
	my $group_by=lc($mi->{group_by});
	my $mi_type=lc($mi->{type});

	if(exists($mi->{sort}) && defined($mi->{sort})) {
		$sort=lc($mi->{sort});
	}

	# Abort if unrecognised sort criteria...
	if($sort ne "date") {
		return(undef,"Unrecognised sort critica for group-meta report: $sort");
	}
	for my $crep_hash (@ALL_REPORTS) {
		my @recs=sort {$a->{fmtime} <=> $b->{fmtime};} (@{$crep_hash->{records}});
		$crep_hash->{records}=[@recs];
	}

	# The reports have all been sorted as necessary, so now group them
	# if requred....

	my %day_map = (
		Sunday => 0,
		Monday => 1,
		Tuesday => 2,
		Wednesday => 3,
		Thursday => 4,
		Friday => 5,
		Saturday => 6
	);

	my @g=split(/:/,$group_by);
	# Handle setting of group_by: month. In this case all reports that
	# fall in the same month are grouped together - however many there may be!
	if($g[0] eq "month") {
		my @ALL_META_REPORTS=();
		my %mtime_list2=();
		my @mtime_list=();
		for my $crep_hash (@ALL_REPORTS) {
			my @FF=();
			my $found_it=0;
			for my $crep (@{$crep_hash->{records}}) {
				my @lt=localtime($crep->{fmtime});
				my $cc=substr($crep->{fdate_str},0,4,) . substr($crep->{fdate_str},5,2);
				my $cc2=substr($crep->{fdate_str},0,4,) . substr($crep->{fdate_str},5,2) . substr($crep->{fdate_str},8,2);
				if(!exists($mtime_list2{$cc})) {
					push @FF,$crep; # Just first record from the time period
					$mtime_list2{$cc}=[$crep];
					if(defined($get_content_repmtime) && $get_content_repmtime == $crep->{fmtime}) {
						push @mtime_list,$crep;
						$found_it=1;
					} elsif($found_it) {
						$found_it=0;
					}
				} elsif($found_it) {
					push @mtime_list,$crep;
				}
			}
			if(defined($get_content_repmtime)) {
				if(@mtime_list) {
					push @mtime_list2,[@mtime_list];
				}
			} else {
				push @ALL_META_REPORTS,{
					report => $meta_report,
					count => scalar(@FF),
					records => [@FF],
					error => undef,
					rawxml => encode_base64($x->get_xml(),""),
				};
			}
		}
		my $lref="";
		if(defined($get_content_repmtime)) {
			# We have a list of report contents and concat them...
			my $err=undef;
			my $rname="meta report for $get_content_rdate";
			# Now we deal with the reports ... assuming
			if($mi_type eq "concat") {
				my $meta_report_instance=-1;
				for my $rr (@mtime_list2) {
					$meta_report_instance++;
					my $rep_info=$x->get_report_info($meta_report_instance);
					if($rep_info->{type} ne "html") {
						return(undef,"Concat report type of '$rep_info->{type}' not supported.");
					}
					for my $crep_ref (@$rr) {
						my ($_x1,$_x2,$_x3)=get_report_contents_by_host_dir_name_mtime($self,$rep_info->{host},
							$rep_info->{directory},$rep_info->{name},$crep_ref->{fmtime});
						$lref.=$$_x1;
					}
				}
			}
			return (\$lref,$err,$rname);
		}
		return ([@ALL_META_REPORTS],undef);
	}
	if($g[0] eq "day") {
		my $dd=$g[1]; $dd="Sunday" if(!defined($dd));
		my $day_num=0; # Sunday
		for my $ck (keys %day_map) {
			if($dd =~ /^$ck/i) {
				$day_num=$day_map{$ck};
				last;
			}
		}
			
		my $count=7;
		$count=$mi->{count} if exists($mi->{count});
		my @ALL_META_REPORTS=();
		my @mtime_list2=();
		my @mtime_list=();
		for my $crep_hash (@ALL_REPORTS) {
			my @FF=();
			my $found_it=0;
			for my $crep (@{$crep_hash->{records}}) {
				my @lt=localtime($crep->{fmtime});
				if($lt[6] == $day_num) {
					push @FF,$crep;
					if(defined($get_content_repmtime) && $get_content_repmtime == $crep->{fmtime}) {
						push @mtime_list,$crep;
						$found_it=1;
					} elsif($found_it) {
						$found_it=0;
					}
				} elsif($found_it) {
					push @mtime_list,$crep;
				}
			}
			if(defined($get_content_repmtime)) {
				if(@mtime_list) {
					push @mtime_list2,[@mtime_list];
				}
			} else {
				push @ALL_META_REPORTS,{
					report => $meta_report,
					count => scalar(@FF),
					records => [@FF],
					error => undef,
					rawxml => encode_base64($x->get_xml(),""),
				};
			}
		}
		my $lref="";
		if(defined($get_content_repmtime)) {
			# We have a list of report contents and concat them...
			my $err=undef;
			my $rname="meta report for $get_content_rdate";
			# Now we deal with the reports ... assuming
			if($mi_type eq "concat") {
				my $meta_report_instance=-1;
				for my $rr (@mtime_list2) {
					$meta_report_instance++;
					my $rep_info=$x->get_report_info($meta_report_instance);
					if($rep_info->{type} ne "html") {
						return(undef,"Concat report type of '$rep_info->{type}' not supported.");
					}
					for my $crep_ref (@$rr) {
						my ($_x1,$_x2,$_x3)=get_report_contents_by_host_dir_name_mtime($self,$rep_info->{host},
							$rep_info->{directory},$rep_info->{name},$crep_ref->{fmtime});
						$lref.=$$_x1;
					}
				}
			}
			return (\$lref,$err,$rname);
		}
		return ([@ALL_META_REPORTS],undef);
	}
	return(undef,"Group by clause not recognised.");
}

sub get_report_xml($$$) {
my $self=shift;
my $report=shift;
my $report_type=shift;

	# Check to see if the report or the meta_report exists. and if grab the
	# xml and return if in the {rawxml} attribute, setting {error} to undef.

	my $r={
		error => undef,
		rawxml => undef,
	};
	my $x;
	my $d=undef;
	if($report_type eq "M") {
		$d=$self->{global_config}->get_directory("meta_reports");
		$x=new gri_meta_report_config("$pd/$report.xml");
		if(!defined($x)) {
			my $e=gri_meta_report_config::error();
			$r->{error}=$e;
			return $r;
		}
	} else {
		$d=$self->{global_config}->get_directory("reports");
		$x=new gri_report_config("$d/$report.xml");
		if(!defined($x)) {
			my $e=gri_report_config::error();
			$r->{error}=$e;
			return $r;
		}
	}
	$r->{rawxml}=encode_base64($x->get_xml(),"");
	return $r;
}

sub report_update {
my $self=shift;
my  ($xmlfile,$desc,$attrs,$hostname,$directory,$pattern,$type,$display_text)=@_;

	my $d=$self->{global_config}->get_directory("reports");
	if(! -f "$d/$xmlfile.xml") {
		return {
			error => "File to update ('$xmlfile.xml') does not exist."
		};
	}
	# Load in details for this particular report...
	my $crep=new gri_report_config("$d/$xmlfile.xml");
	if(!defined($crep)) {
		return {
			error => gri_report_config::error()
		};
	}
	# We Now get/set things, and if there are any changes
	# 
	my $changes=0;
	my $v;
	$v=$crep->get_title();
	if($v ne $desc) {
		$changes++;
		$crep->set_title($desc);
	}
	$v=$crep->get_host();
	if($v ne $hostname) {
		$changes++;
		$crep->set_host($hostname);
	}
	$v=$crep->get_directory();
	if($v ne $directory) {
		$changes++;
		$crep->set_host($hostname);
	}
	$v=$crep->get_name();
	if($v ne $pattern) {
		$changes++;
		$crep->set_name($pattern);
	}
	$v=$crep->get_display_name();
	if($v ne $display_text) {
		$changes++;
		$crep->set_display_name($display_text);
	}
	$v=$crep->get_type();
	if($v ne $type) {
		$changes++;
		$crep->set_type($type);
	}

	# If there are any changes then we need to write out the file...
	if($changes) {
		my $e=$crep->write_file();
		if(defined($e)) {
			return {
				error => $e
			};
		}
	}
	return { ok => 1 };
}

sub set_portal_xml($$$) {
my $self=shift;
my $portal=shift;
my $portal_xml=shift;

	# Check to see if the report or the meta_report exists. and if grab the
	# xml and return if in the {rawxml} attribute, setting {error} to undef.

	my $r={
		validated => undef,
		error => undef
	};
	my $d=undef;
	my $fn=undef;
	$d=$self->{global_config}->get_directory("portals");
	$fn=\&gri_portal_config::validate_xml;
	my $res=&$fn($portal_xml);
	if(defined($res)) {
		print STDERR "Error is $res\n";
		$r->{validated}=$res;
		return $r;
	}

	# If validated we can add/replace the file contents
	my $portal_fname=get_portal_filename($self,$portal);
	print STDERR "portal_fname=$portal_fname\n";
	my $fd;
	open($fd,">$d/$portal_fname.xml.$$") or return {
		validated => undef,
		error => "Failed to write to file '$d/$portal_fname.xml.$$': $!"
		};

	if(! print $fd $portal_xml) {
		return {
			validated => undef,
			error => "Failed to write to file: $!"
		};
	}
	close($fd) or return {
		validated => undef,
		error => "Failed to write to file: $!"
	};

	# Unlink / Replace

	rename("$d/$portal_fname.xml.$$","$d/$portal_fname.xml");
	return $r;
}

sub set_report_xml($$$$) {
my $self=shift;
my $report=shift;
my $report_type=shift;
my $report_xml=shift;

	# Check to see if the report or the meta_report exists. and if grab the
	# xml and return if in the {rawxml} attribute, setting {error} to undef.

	my $r={
		validated => undef,
		error => undef
	};
	my $x;
	my $d=undef;
	my $fn=undef;
	if($report_type eq "M") {
		$d=$self->{global_config}->get_directory("meta_reports");
		$fn=\&gri_meta_report_config::validate_xml;
	} else {
		$d=$self->{global_config}->get_directory("reports");
		$fn=\&gri_report_config::validate_xml;
	}
	print STDERR "Attempting to validate XML...\n";
	my $res=&$fn($report_xml);
	if(defined($res)) {
		print STDERR "Error is $res\n";
	} else {
		print STDERR "No error!\n";
	}
	if($res!=undef) {
		$r->{validated}=$res;
		return $r;
	}

	# If validated we can add/replace the file contents
	my $fd;
	open($fd,">$d/$report.xml.$$") or return {
		validated => undef,
		error => "Failed to write to file: $!"
		};

	if(! print $fd $report_xml) {
		return {
			validated => undef,
			error => "Failed to write to file: $!"
		};
	}
	close($fd) or return {
		validated => undef,
		error => "Failed to write to file: $!"
	};

	# Unlink / Replace

	rename("$d/$report.xml.$$","$d/$report.xml");
	return $r;
}

sub get_report_dynamic($$) {
my $self=shift;
my $report=shift;

	my $x;
	if(!exists($self->{reports}->{$report})) {
		my $pd=$self->{global_config}->get_directory("reports");
		$x=new gri_report_config("$pd/$report.xml");
		if(!defined($x)) {
			my $e=gri_report_config::error();
			return(undef,$e,undef);
		}
		$self->{reports}->{$report}=$x;
	} else {
		$x=$self->{reports}->{$report};
	}
	return ($x->get_dynamic_info);
}

sub get_report_host($$) {
my $self=shift;
my $report=shift;

	my $x;
	if(!exists($self->{reports}->{$report})) {
		my $pd=$self->{global_config}->get_directory("reports");
		$x=new gri_report_config("$pd/$report.xml");
		if(!defined($x)) {
			my $e=gri_report_config::error();
			return(undef,$e);
		}
		$self->{reports}->{$report}=$x;
	} else {
		$x=$self->{reports}->{$report};
	}
	return $x->get_host;
}

sub get_report_fname($$) {
my $self=shift;
my $report=shift;

	my $x;
	if(!exists($self->{reports}->{$report})) {
		my $pd=$self->{global_config}->get_directory("reports");
		$x=new gri_report_config("$pd/$report.xml");
		if(!defined($x)) {
			my $e=gri_report_config::error();
			return(undef,$e);
		}
		$self->{reports}->{$report}=$x;
	} else {
		$x=$self->{reports}->{$report};
	}
	return $x->get_name;
}

sub get_report_attributes($$) {
my $self=shift;
my $report=shift;

	my $x;
	if(!exists($self->{reports}->{$report})) {
		my $pd=$self->{global_config}->get_directory("reports");
		$x=new gri_report_config("$pd/$report.xml");
		if(!defined($x)) {
			my $e=gri_report_config::error();
			return(undef,$e);
		}
		$self->{reports}->{$report}=$x;
	} else {
		$x=$self->{reports}->{$report};
	}
	return $x->get_attributes;
}

sub get_report_directory($$) {
my $self=shift;
my $report=shift;

	my $x;
	if(!exists($self->{reports}->{$report})) {
		my $pd=$self->{global_config}->get_directory("reports");
		$x=new gri_report_config("$pd/$report.xml");
		if(!defined($x)) {
			my $e=gri_report_config::error();
			return(undef,$e);
		}
		$self->{reports}->{$report}=$x;
	} else {
		$x=$self->{reports}->{$report};
	}
	return $x->get_directory;
}

sub get_meta_report_name($$) {
my $self=shift;
my $report=shift;

	my $x;
	if(!exists($self->{meta_reports}->{$report})) {
		my $pd=$self->{global_config}->get_directory("meta_reports");
		$x=new gri_meta_report_config("$pd/$report.xml");
		if(!defined($x)) {
			my $e=gri_meta_report_config::error();
			return(undef,$e);
		}
		$self->{meta_reports}->{$report}=$x;
	} else {
		$x=$self->{meta_reports}->{$report};
	}
	return $x->get_title;
}

sub get_directory($$) {
my $self=shift;
my $type=shift;

		return $self->{global_config}->get_directory($type);
}

sub get_meta_report_attributes($$) {
my $self=shift;
my $report=shift;

	my $x;
	if(!exists($self->{meta_reports}->{$report})) {
		my $pd=$self->{global_config}->get_directory("meta_reports");
		$x=new gri_meta_report_config("$pd/$report.xml");
		if(!defined($x)) {
			my $e=gri_meta_report_config::error();
			return(undef,"Failed to load $pd/$report.xml - $e");
		}
		$self->{meta_reports}->{$report}=$x;
	} else {
		$x=$self->{meta_reports}->{$report};
	}
	return $x->get_attributes;
}

sub get_report_name($$) {
my $self=shift;
my $report=shift;

	my $x;
	if(!exists($self->{reports}->{$report})) {
		my $pd=$self->{global_config}->get_directory("reports");
		$x=new gri_report_config("$pd/$report.xml");
		if(!defined($x)) {
			my $e=gri_report_config::error();
			return(undef,$e);
		}
		$self->{reports}->{$report}=$x;
	} else {
		$x=$self->{reports}->{$report};
	}
	return $x->get_title;
}

sub get_alerts_directory($) {
my $self=shift;

	return $self->{global_config}->get_directory("alerts");
}

sub get_report_paging($$) {
my $self=shift;
my $report=shift;

	my $x;
	if(!exists($self->{reports}->{$report})) {
		my $pd=$self->{global_config}->get_directory("reports");
		$x=new gri_report_config("$pd/$report.xml");
		if(!defined($x)) {
			my $e=gri_report_config::error();
			return(undef,$e);
		}
		$self->{reports}->{$report}=$x;
	} else {
		$x=$self->{reports}->{$report};
	}
	return $x->get_paging;
}

sub get_report_display_name($$) {
my $self=shift;
my $report=shift;

	my $x;
	if(!exists($self->{reports}->{$report})) {
		my $pd=$self->{global_config}->get_directory("reports");
		$x=new gri_report_config("$pd/$report.xml");
		if(!defined($x)) {
			my $e=gri_report_config::error();
			return(undef,$e);
		}
		$self->{reports}->{$report}=$x;
	} else {
		$x=$self->{reports}->{$report};
	}
	return $x->get_display_name;
}

sub get_meta_report_host($$) {
my $self=shift;
my $report=shift;

	my $x;
	if(!exists($self->{meta_reports}->{$report})) {
		my $pd=$self->{global_config}->get_directory("meta_reports");
		$x=new gri_meta_report_config("$pd/$report.xml");
		if(!defined($x)) {
			my $e=gri_meta_report_config::error();
			return(undef,$e);
		}
		$self->{meta_reports}->{$report}=$x;
	} else {
		$x=$self->{meta_reports}->{$report};
	}
	my $rep_c=$x->get_report_count();
	my %H=();
	for(my $c=0; $c<$rep_c; $c++) {
		my $z=$x->get_report_info($c);
		$H{$z->{host}}=1;
	}

	return([sort(keys %H)],undef);
}

sub get_meta_report_type($$) {
my $self=shift;
my $report=shift;

	my $x;
	if(!exists($self->{meta_reports}->{$report})) {
		my $pd=$self->{global_config}->get_directory("meta_reports");
		$x=new gri_meta_report_config("$pd/$report.xml");
		if(!defined($x)) {
			my $e=gri_meta_report_config::error();
			return(undef,$e);
		}
		$self->{meta_reports}->{$report}=$x;
	} else {
		$x=$self->{meta_reports}->{$report};
	}
	my $z=$x->get_meta_info();
	if(!exists($z->{content_type})) {
		return("html",undef);
	}
	return($z->{content_type},undef);
}
sub get_report_desc {
my $self=shift;
my $report=shift;

	my $x;
	if(!exists($self->{reports}->{$report})) {
		my $pd=$self->{global_config}->get_directory("reports");
		$x=new gri_report_config("$pd/$report.xml");
		if(!defined($x)) {
			my $e=gri_report_config::error();
			return(undef,$e);
		}
		$self->{reports}->{$report}=$x;
	} else {
		$x=$self->{reports}->{$report};
	}
	return $x->get_desc;
}

sub get_report_type($$) {
my $self=shift;
my $report=shift;

	my $x;
	if(!exists($self->{reports}->{$report})) {
		my $pd=$self->{global_config}->get_directory("reports");
		$x=new gri_report_config("$pd/$report.xml");
		if(!defined($x)) {
			my $e=gri_report_config::error();
			return(undef,$e);
		}
		$self->{reports}->{$report}=$x;
	} else {
		$x=$self->{reports}->{$report};
	}
	return $x->get_type;
}

sub get_host_ctime($$) {
my $self=shift;
my $host=shift;

	my ($a,$b)=send_backend_request($self,$host,'GET_CTIME');
	if(!$a) {
		return(undef,join("\n",@$b));
	}
	chomp $b;
	return($b,undef);
}

sub query_backend($$$) {
my $self=shift;
my $host=shift;
my $query=shift;

	my ($a,$b)=send_backend_request($self,$host,$query);
	if(!$a) {
		return(undef,$b);
	}
	chomp $b;
	return($b,undef);
}

# This needs to be modified to make use of the generic
# function for communication with the authentication daemon
# since that function will use the encryption if necessary.

sub query_authd($$) {
my $self=shift;
my $query=shift;

	my ($a,$b)=send_authd_request($self,$query);
	if(!$a) {
		print STDERR "query_authd error: $_\n" foreach(@$b);
		return undef;
	}
	if($query =~ /GET_USER_LIST/) {
		my $l1=$b;
		if($l1 =~ /^ERROR/) {
			chomp $l1;
			return $l1;
		}
		my @F=split(/\s+/,$l1);
		my $c=$F[1];
		my $r="$l1";
		for(0 .. $c-1) {
			$l1=<$fd>;
			$r.=$l1;
		}
		chomp $r;
		return $r;
	}
	my $cline=$b; chomp $cline;
	return($cline);
}

sub get_report_filename($$$$) {
my $self=shift;
my $portal=shift;
my $report=shift;
my $repnum=shift;

	my $err=undef;
	my ($fd,$x);
	if(!exists($self->{reports}->{$report})) {
		my $pd=$self->{global_config}->get_directory("reports");
		$x=new gri_report_config("$pd/$report.xml");
		if(!defined($x)) {
			my $e=gri_report_config::error();
			return(undef,$e);
		}
		$self->{reports}->{$report}=$x;
	} else {
		$x=$self->{reports}->{$report};
	}

	my $host=$x->get_host;
	my $dir=$x->get_directory;
	my $name=$x->get_name;
	my $cline;
	($cline,$err)=query_backend($self,$host,"GET_REPORT_FILENAME DIR=$dir NAME=$name INST=$repnum\n");
	if(!defined($cline)) {
		return(undef,join("\n",@$err));
	}
	chomp $cline;
	if($cline =~ /^OK\s+/) {
		$cline=~ s/^OK\s+//;
		return(1,$cline);
	}
	$cline=~ s/^ERROR:\s+//;
	return(0,$cline);
}

sub get_report_contents($$$$) {
my $self=shift;
my $portal=shift;
my $report=shift;
my $repnum=shift;

	my $err=undef;
	my ($fd,$x);
	if(!exists($self->{reports}->{$report})) {
		my $pd=$self->{global_config}->get_directory("reports");
		$x=new gri_report_config("$pd/$report.xml");
		if(!defined($x)) {
			my $e=gri_report_config::error();
			return(undef,$e);
		}
		$self->{reports}->{$report}=$x;
	} else {
		$x=$self->{reports}->{$report};
	}

	my $host=$x->get_host;
	my $dir=$x->get_directory;
	my $name=$x->get_name;
	my $cline;
	($cline,$err)=query_backend($self,$host,"GET_REPORT_CONTENTS DIR=$dir NAME=$name INST=$repnum\n");
	if(!defined($cline)) {
		return(undef,join("\n",@$err));
	}
	my $ff=index($cline,"\n");
	my $s1=substr($cline,0,$ff);
	my @FFF=split(/\s+/,$s1); 
	my $bytes=int($FFF[0]);
	my $rname;
	if(@FFF>1) {
		$rname=basename($FFF[1]);
	} else {
		$rname=undef;
	}
	my $res=substr($cline,$ff+1);
	return(\$res,undef,$rname);
}

sub get_report_contents_by_host_dir_name_mtime($$$$$) {
my $self=shift;
my $host=shift;
my $dir=shift;
my $name=shift;
my $repmtime=shift;

	my ($a,$err,$rname)=get_report_contents_from_query($self,$host,"GET_REPORT_CONTENTS DIR=$dir NAME=$name MTIME=$repmtime\n");
	if(!defined($a)) {
		return(undef,join("\n",@$err));
	}
	return(\$a,undef,$rname);
}

sub get_report_contents_by_host_dir_mtime($$$$) {
my $self=shift;
my $portal=shift;
my $report=shift;
my $repmtime=shift;

	my $err=undef;
	my ($fd,$x);
	if(!exists($self->{reports}->{$report})) {
		my $pd=$self->{global_config}->get_directory("reports");
		$x=new gri_report_config("$pd/$report.xml");
		if(!defined($x)) {
			my $e=gri_report_config::error();
			return(undef,$e);
		}
		$self->{reports}->{$report}=$x;
	} else {
		$x=$self->{reports}->{$report};
	}

	my $host=$x->get_host;
	my $dir=$x->get_directory;
	my $name=$x->get_name;
	my ($a,$rname);
	($a,$err,$rname)=get_report_contents_from_query($self,$host,"GET_REPORT_CONTENTS DIR=$dir NAME=$name MTIME=$repmtime\n");
	if(!defined($a)) {
		return(undef,join("\n",@$err));
	}
	return(\$a,undef,$rname);
}

sub get_template_directory {
my $self=shift;

	return $self->{global_config}->get_directory("templates");
}

sub get_tmp_content_dir {
my $self=shift;

	return $self->{global_config}->get_localdir();
}

sub get_tmp_urlref {
my $self=shift;

	return $self->{global_config}->get_urlref();
}

sub get_file_checksum($$$$) {
my $self=shift;
my $portal=shift;
my $report=shift;
my $file=shift;

	my $err=undef;
	my ($fd,$x);
	if(!exists($self->{reports}->{$report})) {
		my $pd=$self->{global_config}->get_directory("reports");
		$x=new gri_report_config("$pd/$report.xml");
		if(!defined($x)) {
			my $e=gri_report_config::error();
			return(undef,$e);
		}
		$self->{reports}->{$report}=$x;
	} else {
		$x=$self->{reports}->{$report};
	}
	my $host=$x->get_host;
	my ($a,$b)=query_backend($self,$host,"GET_CHECKSUM FILE=$file\n");
	if(!defined($a)) {
		return(undef,join("\n",@$err));
	}
	my $cline=$a;
	if($cline =~ /^OK/) {
		my @F=split(/\s+/,$cline);
		return($F[1],undef);
	} else {
		return(undef,$cline);
	}
}

# For GRI2 if the filename has been specified we retrieve
# the directory name as necessary and prepend it to the
# file in question...

sub get_file($$$$) {
my $self=shift;
my $portal=shift;
my $report=shift;
my $file=shift;

	my $err=undef;
	my ($fd,$x);
	if(!exists($self->{reports}->{$report})) {
		my $pd=$self->{global_config}->get_directory("reports");
		$x=new gri_report_config("$pd/$report.xml");
		if(!defined($x)) {
			my $e=gri_report_config::error();
			return(undef,$e);
		}
		$self->{reports}->{$report}=$x;
	} else {
		$x=$self->{reports}->{$report};
	}
	if(dirname($file) eq ".") {
		my $d=$self->{reports}->{$report}->get_directory();
		$file=File::Spec->catfile($d,$file);
	}
	my $host=$x->get_host;
	my ($a,$b)=query_backend($self,$host,"GET_CONTENTS FILE=$file\n");
	if(!defined($a)) {
		return(undef,join("\n",@$b));
	}
	my $cline=$b;
	if($cline =~ /^ERROR/) {
		return(undef,$cline);
	}
	my $ff=index($cline,"\n");
	my $s1=substr($cline,0,$ff);
	my $bytes=int($s1);
	$cline=substr($cline,$ff+1);
	return(\$cline,undef);
}

sub get_backend_port {
my $self=shift;

	return $self->{global_config}->get_port("backend");
}

sub get_global_directory {
my $self=shift;
my $dir=shift;

	return $self->{global_config}->get_directory($dir);
}

sub get_authd_port {
my $self=shift;

	return $self->{global_config}->get_port("authd");
}

sub get_variable {
my $self=shift;
my $var=shift;

	my $x=$self->{global_config}->get_variable($var);
	$x="?$var not defined?" if !defined($x);
	return $x;
}

{
my $_l=undef;
my $_lt=0;

sub date_str {
my $self=shift;
my $t=shift;

	if($_lt+5<time) {
		$_l=undef;
	}
	my $x;
	if($_l) {
		$x=$_l;
	} else {
		my $user=get_user_name();
		if($user) {
			my $p=$self->get_user_prefs($user);
			if($p && $p->{prefs_obj}) {
				$x=$p->{prefs_obj}->get_pref_value("date_fmt");
			}
		}
		if(! $x) {
			$x=$self->{global_config}->get_variable("DATE_FMT");
		}
		$x='%d/%m/%Y' if !defined($x);
		$_l=$x;
		$_lt=time;
	}
	if(ref($t)) {
		return strftime($x,@$t);
	}
	return strftime($x,localtime($t));
}

}

sub internal_to_posix_time($) {
my $self=shift;
my $s=shift;

	my @t=split(/\./,$s);
	if(@t!=6 && @t!=3) {
		return([0,0,0,1,0,71]); # Default to UNIX epoch
	}
	if(@t==6) {
		return([int($t[5]),int($t[4]),int($t[3]),int($t[2]),int($t[1])-1,int($t[0]-1900)]);
	} else {
		# default hh:mm:ss to 00:00:00 if not present.
		return([0,0,0,int($t[2]),int($t[1])-1,int($t[0]-1900)]);
	}
}

{
my $_l=undef;
my $_lt=0;

sub datetime_str {
my $self=shift;
my $t=shift;
	
	if($_lt+5<time) {
		$_l=undef;
	}
	my $x;
	if($_l) {
		$x=$_l;
	} else {
		my $user=get_user_name();
		if($user) {
			my $p=$self->get_user_prefs($user);
			if($p && $p->{prefs_obj}) {
				$x=$p->{prefs_obj}->get_pref_value("datetime_fmt");
			}
		}
		if(! $x) {
			$x=$self->{global_config}->get_variable("DATETIME_FMT");
		}
		$x='%d/%m/%Y %H:%M:%S' if !defined($x);
		$_l=$x;
		$_lt=time;
	}
	if(ref($t)) {
		return strftime($x,@$t);
	}
	return strftime($x,localtime($t));
}

}

{
my $_l=undef;
my $_lt=0;

sub long_datetime_str {
my $self=shift;
my $t=shift;

	if($_lt+5<time) {
		$_l=undef;
	}
	my $x;
	if($_l) {
		$x=$_l;
	} else {
		my $user=get_user_name();
		if($user) {
			my $p=$self->get_user_prefs($user);
			if($p && $p->{prefs_obj}) {
				$x=$p->{prefs_obj}->get_pref_value("long_datetime_fmt");
			}
		}
		if(! $x) {
			$x=$self->{global_config}->get_variable("LONG_DATETIME_FMT");
		}
		$x='%c' if !defined($x);
		$_l=$x;
		$_lt=time;
	}
	if(ref($t)) {
		return strftime($x,@$t);
	}
	return strftime($x,localtime($t));
}

}

sub get_variable_list {
my $self=shift;

	return ($self->{global_config}->get_variable_list());
}

sub get_url_prefix {
my $self=shift;

	my $proto=$self->{global_config}->get_variable("PROTOCOL");
	my $host=$self->{global_config}->get_variable("HOST");
	my $url=$self->{global_config}->get_variable("URLPREFIX");
	$proto="http" if !defined($proto);
	$host=hostname() if !defined($host);
	if(!defined($url) || $url eq "") {
		return "$proto://$host";
	}
	return "$proto://$host/$url";
}

sub get_extjs4_url_prefix {
my $self=shift;

	my $proto=$self->{global_config}->get_variable("EXTJS4_PROTOCOL");
	my $host=$self->{global_config}->get_variable("EXTJS4_HOST");
	my $url=$self->{global_config}->get_variable("EXTJS4_URLPREFIX");
	$proto="http" if !defined($proto);
	$host=hostname() if !defined($host);
	if(!defined($url) || $url eq "") {
		return "$proto://$host";
	}
	return "$proto://$host/$url";
}

sub get_authd_host {
my $self=shift;

	return $self->{global_config}->get_port("authd_host");
}

sub send_backend_request($$$) {
my $self=shift;
my $host=shift;
my $request=shift;

	my $port=$self->{global_config}->get_port("backend");
	my $secure=$self->{global_config}->get_port("backend_protocol");

	my $rc=0;
	my $resp=undef;

	my ($fd,$err)=_get_client_sock($host,$port);
	if(! $fd) {
		return(0,[$err]);
	}
	if(! $secure) {
		print $fd $request;
		my $res=<$fd>; close($fd);
		return(1,$res);
	}

	# Ok - things get more complex now ... we want to talk to the
	# server in a secure manner ... it will expect us to use a
	# privkey to decode a session key for request/response.
	my $uid="backend/$host";
	my $private_key=undef;
	my $session_key=undef;
	{
		my ($a,$b)=gri2_rsatcp::find_priv_key({
			keys	=> $self->{backend_privkeys},
			'username/host'	=> $uid,
		});
		if(!$a) {
			close($fd);
			return(0,$b);
		}
		$private_key=$b;
	}

	my ($a,$b)=gri2_rsatcp::client_send_data({
		fd				=> $fd,
		'username/host'	=> $uid,
		private			=> $private_key,
		message			=> $request,
	});
	if(!$a) {
		close($fd);
		return(0,$b);
	}
	$session_key=$b;
	($a,$b)=gri2_rsatcp::client_recv_data({
		fd				=> $fd,
		session_key		=> $session_key,
	});
	close($fd);
	if(!$a) {
		return(0,$b);
	}
	return(1,$b);
}

sub send_authd_request($$) {
my $self=shift;
my $request=shift;

	my $host=$self->{global_config}->get_port("authd_host");
	my $port=$self->{global_config}->get_port("authd");
	my $secure=$self->{global_config}->get_port("authd_protocol");

	my $rc=0;
	my $resp=undef;

	my ($fd,$err)=_get_client_sock($host,$port);
	if(! $fd) {
		return(0,[$err]);
	}
	if(! $secure) {
		print $fd $request;
		my $res=<$fd>; close($fd);
		return(1,$res);
	}

	# Ok - things get more complex now ... we want to talk to the
	# server in a secure manner ... it will expect us to use a
	# privkey to decode a session key for request/response.
	my $uid='gri/' . hostname();
	my ($a,$b)=gri2_rsatcp::client_send_data({
		fd				=> $fd,
		'username/host'	=> $uid,
		private			=> $self->{authd_privkey},
		message			=> $request,
	});
	if(!$a) {
		close($fd);
		return(0,$b);
	}
	my $session_key=$b;
	($a,$b)=gri2_rsatcp::client_recv_data({
		fd				=> $fd,
		session_key		=> $session_key,
	});
	close($fd);
	if(!$a) {
		return(0,$b);
	}
	return(1,$b);
}

{
my %user_emails=();

sub get_user_email_address($$) {
my $self=shift;
my $user=shift;

	if(exists($user_emails{$user})) {
		return $user_emails{$user};
	}
	if(!exists($::ENV{GRI_USER_TO_EMAIL})) {
		$user_emails{$user}=undef;
		return undef;
	}
	if(! -x $::ENV{GRI_USER_TO_EMAIL}) {
		$user_emails{$user}=undef;
		return undef;
	}
	my $e=`$::ENV{GRI_USER_TO_EMAIL} $user 2>/dev/null`;
	chomp $e;
	if(length($e)) {
		$user_emails{$user}=$e;
		return $e;
	}
	$user_emails{$user}=undef;
	return undef;
}

}

sub get_email_address {
my $self=shift;

	return $self->{global_config}->get_email_address($_[0]);
}

sub generate_email_command {
my $self=shift;

	return  $self->{global_config}->generate_email_command();
}

sub get_email_sent_from_address {
my $self=shift;

	return  $self->{global_config}->get_email_sent_from_address();
}

sub _put_line($$) {
my $fd=shift;
my $line=shift;

	if(! print $fd $line) {
		return(0,"Failed to write to socket - command failed?");
	}
	return(1,undef);
}

sub send_email($$) {
my $self=shift;
my $r=shift;

	my $email_cmd=generate_email_command($self);

	my $fd;
	if(!open($fd,"|$email_cmd >/dev/null")) {
		return(0,"Failed to run email handling command in mm_send_email2.");
	}

	my ($rc,$err);
	if($r->{html}) {
		($rc,$err)=_put_line($fd,"Mime-Version: 1.0\nContent-type: text/html; charset=\"iso-8859-1\"\n");
	} else {
		($rc,$err)=_put_line($fd,"Mime-Version: 1.0\nContent-type: text/plain; charset=\"iso-8859-1\"\n");
	}
	return(0,$err) if !$rc;

	if(!exists($r->{from}) || !defined($r->{from})) {
		$r->{from}=get_email_sent_from_address($self);
	}
	my @lines=(
		"From: $r->{from}\n",
		"To: $r->{to}\n"
	);

	if(exists($r->{cc}) && defined($r->{cc})) {
		push @lines,"Cc: $r->{cc}\n";
	}
	push @lines, "Subject: $r->{subject}\n\n", $r->{content};

	for my $cl (@lines) {
		($rc,$err)=_put_line($fd,$cl);
		return(0,$err) if !$rc;
	}
	close($fd);
	return(1,undef);
}

sub format_display_name($$$;$) {
my $self=shift;
my $date=shift;
my $str=shift;
my $fname=shift;	# Might be blank
my @m=qw(dummy
	January
	February
	March
	April
	May
	June
	July
	August
	September
	October
	November
	December
);

	if(!$str) {
		my $tref=$self->internal_to_posix_time($date);
		my $xx=$self->datetime_str($tref);
		return $xx;
	}
	my @F=split(/\./,$date);
	my $x="th";
	$F[2]=int($F[2]);
	if($F[2]==1 || $F[2]==21 || $F[2]==31) {$x="st";}
	if($F[2]==2 || $F[2]==22) {$x="nd";}
	if($F[2]==3 || $F[2]==23) {$x="rd";}
	my $str_day="$F[2]$x";
	my $tstr=sprintf("%02d:%02d:%02d",$F[3],$F[4],$F[5]);
	$str =~ s/\%day/$F[2]/g;
	$str =~ s/\%month/$F[1]/g;
	$str =~ s/\%year/$F[0]/g;
	$str =~ s/\%str_day/$str_day/g;
	$str =~ s/\%str_month/$m[$F[1]]/g;
	$str =~ s/\%time/$tstr/g;

	# We now check for [[sub x,y]] constructs and if
	# present replace them with the substrings from
	# the filename - if available of course.

	if(defined($fname)) {
		my ($x,$y)=($str =~ /\[\[sub\s+(\d+),(\d+)\]\]/i);
		while(defined($x) && defined($y)) {
			my $z=substr($fname,$x,$y);
			$str =~ s/\[\[sub\s+\d+,\d+\]\]/$z/i;
			($x,$y)=($str =~ /\[\[sub\s+(\d+),(\d+)\]\]/i);
		}
	}
	return $str;
}

sub get_defined_roles {
my $self=shift;

	if(!defined($self->{ROLES})) {
		my $config_file=dirname($self->{global_config_file}) . "/gri_roles_config.xml";
		my $cfg=new gri_roles_config($config_file);
		if(!defined($cfg)) {
			return(undef,"Unable to open/load file '$config_file'.");
		}
		$self->{ROLES}=$cfg;
	}

	my %roles=();
	for my $crole ($self->{ROLES}->get_role_list()) {
		my ($xx,$yy)=$self->{ROLES}->get_role_details($crole);
		$roles{$crole}={title => $xx, description => $yy};
	}
	return ({%roles},undef);
}

sub does_user_have_role {
my $self=shift;
my $user=shift;
my $role=shift;

	# If the user is not defined, then get it from cookie..
	if(!defined($user)) {
		$user=get_user_name();
	}
	if(!defined($self->{ROLES})) {
		my $config_file=dirname($self->{global_config_file}) . "/gri_roles_config.xml";
		my $cfg=new gri_roles_config($config_file);
		if(!defined($cfg)) {
			return(undef,"Unable to open/load file '$config_file'.");
		}
		$self->{ROLES}=$cfg;
	}
	my $role_dir=get_global_directory($self,"users");
	if(!defined($role_dir)) {
		return(undef,"Unable to get users directory for role writing!");
	}
	if(! -f "$role_dir/$user.role") {
		return(0,undef);
	}
	my ($fd,$cline);
	if(! open($fd,"$role_dir/$user.role")) {
		return(undef,"Failed to open file '$role_dir/$user.role'.");
	}
	$cline=<$fd>; chomp $cline; close($fd);
	$cline =~ s/\s+//g;
	my @R=split(/,/,$cline);
	if(grep {$_ eq $role} @R) {
		return(1,undef);
	}
	return(0,undef);
}

sub get_role_count {
my $self=shift;

	my $role_dir=get_global_directory($self,"users");
	if(!defined($role_dir)) {
		return {
			count => 0,
			error => "Users directory not defined."
		};
	}
	my $fd;
	if(!opendir($fd,$role_dir)) {
		return {
			count => 0,
			error => "Cannot read users directory: $!",
		};
	}
	my $cd=0;
	while(my $c=readdir($fd)) {
		if($c =~ /\.role$/) {
			$cd++;
		}
	}
	closedir($fd);
	return {
		count => $cd,
		error => undef,
	};
}

sub read_user_role {
my $self=shift;
my $user=shift;

	my $role_dir=get_global_directory($self,"users");
	if(!defined($role_dir)) {
		return {
			roles => [],
			error => "Unable to get users directory for role reading!"
		};
	}
	my $f="$role_dir/$user.role";
	if(! -f $f) {
		return {
			roles => [],
			error => undef
		};
	}
	my ($fd,$cline,@F);
	open($fd,$f) or 
		return {
			roles => [],
			error => "Unable to read file $f: $!"
		};
	$cline=<$fd>; close($fd); chomp $cline;
	$cline =~ s/\s+//g;
	@F=split(/,/,$cline);
	return {
		roles => [@F],
		error => undef
	};
}

sub write_user_role {
my $self=shift;
my $user=shift;
my $roles=shift;

	my $role_dir=get_global_directory($self,"users");

	if(!defined($role_dir)) {
		return(0,"Unable to get users directory for role writing!");
	}
	my $ff="$role_dir/$user.role";
	my $role_string=join(",",@$roles);

	# Write to temporary file and then rename

	my $fd;
	open($fd,">$ff.$$");
	if(!defined($fd)) {
		return(0,"Unable to write to directory '$role_dir'.");
	}
	if(! print $fd "$role_string\n") {
		close($fd); unlink("$ff.$$");
		return(0,"Unable to write to file '$ff.$$' - out of space?");
	}
	if(!close($fd)) {
		close($fd); unlink("$ff.$$");
		return(0,"Unable to write to file '$ff.$$' - out of space?");
	}
	
	rename("$ff.$$",$ff);
	return(1,undef);
}

{
my $mime_info=undef;

sub get_supported_types_list {
my $self=shift;

	if(!defined($mime_info)) {
		my $mime_file=get_variable($self,"MIME_FILE");
		if(defined($mime_file)) {
			$mime_info=new gri_mime($mime_file);
		}
		if(!defined($mime_info)) {
			$mime_info="NONE";
		}
	}
	if(!ref($mime_info)) {
		return("html","text","csv","pdf","xls","rtf","doc","xlsx","docx");
	}
	return $mime_info->get_types_list();
}

sub get_supported_type_desc_list {
my $self=shift;

	if(!defined($mime_info)) {
		my $mime_file=get_variable($self,"MIME_FILE");
		if(defined($mime_file)) {
			$mime_info=new gri_mime($mime_file);
		}
	}
	if(!defined($mime_info) || !ref($mime_info)) {
		return {
			html => "HTML",
	    	text => "Text File",
			csv => "Comma Separated Values",
			pdf => "Adobe Portable Document Format",
			rtf => "Rich Text File",
		};
	}
	my @t=$mime_info->get_types_list();
	my %R=();
	for my $ct (@t) {
		my @x=$mime_info->get_type_info($ct);
		$R{$ct}=$x[0];
	}
	return {%R};
}

sub get_type_info {
my $self=shift;
my $type=shift;

	if(!defined($mime_info)) {
		my $mime_file=get_variable($self,"MIME_FILE");
		if(defined($mime_file)) {
			$mime_info=new gri_mime($mime_file);
		}
		if(!defined($mime_info)) {
			$mime_info="NONE";
		}
	}
	if(!ref($mime_info)) {
		return(undef,undef,undef,undef);
	}
	return ($mime_info->get_type_info($type));
}

}

# Given a list of UID's retun a map of user name => email addresses.

sub uid_map {
my $self=shift;
my $lref=shift;

	my $type=get_variable($self,"UID_MAPPER_TYPE");
	my $args=get_variable($self,"UID_MAPPER_ARGS");

	if($type eq "S") {
		my ($host,$port)=split(/\s+/,$args);
		if(!defined($port)) {
			$port=$host;
			$host="localhost";
		}
		# Make a connection for each of the UID's to Map ...
		my %map=();
		my $IADDR   = inet_aton($host) || return {
				error => "host resolution failure: $host",
				uids  => {},
			};

		my $PADDR   = sockaddr_in($port, $IADDR);
		my $PROTO   = getprotobyname('tcp');

		for my $uid (@$lref) {

			socket(SOCK, PF_INET, SOCK_STREAM, $::PROTO) || return {
					error => "socket call failure: $!",
					uids  => {},
				};

			connect(SOCK, $PADDR) || return {
					error => "socket connect failure: $!",
					uids  => {},
				};

			{ my $x=select(SOCK); $|=1; select($x); }
			print SOCK "$uid\n";
			my @lines=map {chomp; $_;} <SOCK>;
			close (SOCK)            || die "close: $!";

			# Now if we get just a single mail: line then return that one...

			my $fn="";
			my @fnk=grep {/^givenname:\s+/i} @lines;
			if(@fnk) {
				($fn)=($fnk[0] =~ /^givenname:\s+(.*)/i);
			} else {
				@fnk=grep {/^displayname:\s+/i} @lines;
				if(@fnk) {
					$fn=$fnk[0];
				}
			}
			my @email=grep {/^mail:\s+/} @lines;
			if(@email) {
				my ($a)=($email[0] =~ /^mail:\s+(.*)/);
				$map{$uid}={
					email => $a,
					name => $fn,
				};
			}
		}
		return {
			error => undef,
			uids  => {%map},
		};
	} else {
		return {
			error => "Supported uid_map type '$type' not supported.",
			uids => {},
		};
	}
}

# If a user makes a request for a portal access via GRI2 this will 
# eventually get called ... it should register the details
# and return a uniq id to the user (which they can use to chase request
# get emails etc.)
#
# Use a new module for this gri2_requests which stores the stuff
# in sqlite records ... see that module for more details...

sub register_portal_access_request($$$$) {
my ($self,$user,$portal,$txt)=@_;

	my $rr=$self->{gri2_requests}->register_portal_access_request($username,$portal,$txt,$self);
	return $rr;
}

# Return a list of files for the user that they can access
# that have most recently been updated. We return 10 files or
# N if the count is provided by options. Here we do not use 
# preferences since the JS frontend is meant to take care of
# that.

sub get_latest_updated_reports($$;$$) {
my ($self,$user_name,$_count,$_age)=@_;

my @mon=qw(
	January February March April May June
	July August September October November December
);

	my $count=5;
	my $age=72;
	$count=$_count if defined($_count);
	$age=$_age if defined($_age);

	#################################################################
	# If we the user preference or default is 1, so scan list of	#
	# recent files that are applicable to the user and process...	#
	#################################################################

	my $lref=get_portal_list($self);
	my @L=(@$lref);
	my $tmpdir=get_tmp_content_dir($self);
	return {
		error => "No report_updates.lst file exists",
		reports => undef
	} if ! -f "$tmpdir/report_updates.lst";

	my @RL=();
	for my $c (@L) {
		my $a=is_user_allowed($self,$c,$user_name);
		next if !$a;
		my $portal_fname=get_portal_filename($self,$c);
		my ($lref,$err)=get_portal_report_names($self,$c);
		if($lref) {
			for my $rep (@$lref) {
				push @RL,[$rep,$c];
			}
		}
	}
	my $fd;
	if(!open($fd,"$tmpdir/report_updates.lst")) {
		return {
			error => "Unable to open report_updates.lst: $!",
			reports => undef
		};
	}
	my @D=<$fd>;
	close($fd);
	my @sb=stat("$tmpdir/report_updates.lst");
	my @lt=localtime($sb[9]);
	my $sss=sprintf("[Last Updated %02d:%02d %s %d, %04d]",
		$lt[2],$lt[1],$mon[$lt[4]],$lt[3],$lt[5]+1900);
	my $now=time;
	my $ctime=$now-($age*3600);
	my @RL2=();
	for my $_rep (@RL) {
		$rep=$_rep->[0];
		$portal=$_rep->[1];
		my @LL=grep {/^$rep\|/} @D;
		if(@LL) {
			my @LL2=split(/\|/,$LL[0]);
			my $aa=$now - $LL2[3];
			if($LL2[3]>$ctime) {
				my $x="$LL[0]|$portal";
				$x =~ s/\n//g;
				push @RL2,$x;
			} else {
				print STDERR "Reports for '$rep' - too old [$LL2[3] Age: $aa]\n";
			}
		}
	}
	@RL2=sort {
		my @A=split(/\|/,$a);
		my @B=split(/\|/,$b);
		$A[3] <=> $B[3];
	} @RL2;
	my $str="";
	# Sort and return most $count most recent... 
	my $row=0;
	my @reports=();
	while($count) {
		$count--;
		my $x2=pop @RL2;
		last if !defined($x2);
		my @x=split(/\|/,$x2);
		my $r_file=$x[0];
		my $r_name=$x[6];
		my $r_type=$x[5];
		my $r_mtime=$x[3];
		my $r_date=$x[4];
		my $r_size=$x[2];
		my $r_portal=$x[$#x];
		push @reports,{
			file => $r_file,
			name => $r_name,
			type => $r_type,
			mtime => $r_mtime,
			date => $r_date,
			size => $r_size,
			portal => $r_portal,
			};
	}
	return {
		error => undef,
		reports => [@reports]
	};
}

sub get_user_prefs($$) {
my $self=shift;
my $user=shift;

	my $compare=0;
	my $prefs_obj=undef;
	my $prefs_dir=$self->{global_config}->get_directory("users");
	if(-f "$prefs_dir/$user-prefs.xml") {
		$compare=1;
		$prefs_obj=new gri_userprefs("$prefs_dir/$user-prefs.xml");
	} elsif(-f "$prefs_dir/__DEFAULT__-prefs.xml") {
		$prefs_obj=new gri_userprefs("$prefs_dir/__DEFAULT__-prefs.xml");
	} else {
		return {
			error => "No preference information found.",
			prefs => {},
			prefs_obj => undef,
		};
	}
	# Compare the user and default prefs and update user prefs
	# if appropriate. This will ensure new preferences are automatically
	# added as user accesses them via this interface...
	if($compare && defined($prefs_obj)) {
		my $changes=0;
		my $def_prefs=new gri_userprefs("$prefs_dir/__DEFAULT__-prefs.xml");
		if($def_prefs) {
			my ($in_self,$in_other)=$prefs_obj->compare($def_prefs);
			for my $cp (@$in_self) {
				$changes++;
				$prefs_obj->remove($cp->{key});
			}
			for my $cp (@$in_other) {
				$changes++;
				$prefs_obj->add($cp);
			}
		}
		if($changes) {
			my ($a,$b)=$prefs_obj->write("$prefs_dir/$user-prefs.xml");
			if($a==0) {
				return {
					error => $b,
					prefs => {},
					prefs_obj => undef,
				};
			}
		}
	}
	if(!defined($prefs_obj)) {
		my $err=gri_userprefs::get_error();
		return {
			error => "No preferences information found.",
			prefs => {},
			prefs_obj => undef,
		};
	}
	return {
		error => undef,
		prefs => $prefs_obj->get_raw_prefs(),
		prefs_obj => $prefs_obj,
	};
}

# Set user prefs loads in the existing details (or default),
# applies any changes and then writes out the preferences
# record...

sub set_user_prefs($$$) {
my $self=shift;
my $user=shift;
my $updated_prefs=shift;

	# Firstly load in the preferences...
	my $prefs_obj=undef;
	my $prefs_dir=$self->{global_config}->get_directory("users");
	if(-f "$prefs_dir/$user-prefs.xml") {
		$prefs_obj=new gri_userprefs("$prefs_dir/$user-prefs.xml");
	} elsif(-f "$prefs_dir/__DEFAULT__-prefs.xml") {
		$prefs_obj=new gri_userprefs("$prefs_dir/__DEFAULT__-prefs.xml");
	} else {
		return {
			error => "No preference information found.",
			info => undef
		};
	}
	if(!defined($prefs_obj)) {
		my $err=gri_userprefs::get_error();
		return {
			error => "No preferences information found.",
			info => undef
		};
	}
	for my $cpref (keys %{$updated_prefs}) {
		$prefs_obj->set_pref_value($cpref,undef,$updated_prefs->{$cpref});
	}
	my ($a,$b)=$prefs_obj->write("$prefs_dir/$user-prefs.xml");
	if($a==0) {
		return {
			error => $b,
			info => undef
		};
	}
	return {
		error => undef,
		info => "Preferences updated"
	};
}

#########################################################################
# Get details of currently configured using alerting and all reports	#
# the user currently has access to.										#
#########################################################################

sub get_user_alerting_info {
my $self=shift;
my $user=shift;

	my $alerts_dir=$self->get_global_directory("alerts");
	my $user_alerting;
	if(-f "$alerts_dir/$user.config.xml") {
		$user_alerting=new gri_user_alert_config("$alerts_dir/$user.config.xml");
	} else {
		$user_alerting=new gri_user_alert_config();
	}
	my $lref=$self->get_portal_list();
	my @L=(@$lref);
	my %stuff=();
	for my $c (@L) {
		my $a=$self->is_user_allowed($c,$user);
		if(!$a) {
			print STDERR "User $user not allowed access to '$c'.\n";
			next;
		}
		my $portal_fname=$self->get_portal_filename($c);
		my ($lref,$err)=$self->get_portal_report_names($c);
		if($lref) {
			for my $rep (@{$lref}) {
				my @info=$self->get_portal_report_details($c,$rep);
				$stuff{$rep}={
					text => $info[0],
					name => "AL_$rep",
					value => "$rep~$portal_fname",
					portal => $portal_fname,
					alerting => 0,
					error => undef,
				};
			}
		}
	}
	for my $crep (keys %{$user_alerting->{reports}}) {
		my $xx=$crep; $xx =~ s/^AL_//;
		$stuff{$xx}->{alerting}=1;
	}
	# my @_slist=sort {lc($stuff{$a}->{text}) cmp lc($stuff{$b}->{text});} keys(%stuff);
	# for my $ckey (@_slist) {
		# my $portal_fname=$stuff{$ckey}->{portal};
		# if(grep {$_ eq $ckey} @REPS) {
			# $stuff{$ckey}->{alerting}=1;
		# }
	# }
	return {%stuff};
}

# Take a list of portal/report entries for a user and make
# them the current list of reports that they want alerting for.

sub set_user_alerting_info {
my $self=shift;
my $user=shift;
my $alerts=shift;

	my $alerts_dir=$self->get_global_directory("alerts");
	my $user_alerting;
	if(-f "$alerts_dir/$user.config.xml") {
		$user_alerting=new gri_user_alert_config("$alerts_dir/$user.config.xml");
	} else {
		$user_alerting=new gri_user_alert_config();
	}

	my @R=();
	for my $crep (@$alerts) {
		push @R,$crep->{name},$crep->{portal};
	}
	$user_alerting->set_reports(@R);
	my $res=$user_alerting->write_file();
	if($res==0) {
		return {
			error => $gri_user_alert_config::error
		};
	}
	return { error => undef };
}

# action=ping or dir or matches or all3 (does all three checks)

sub host_checks($$$$) {
my ($self,$host,$action,$arg)=@_;

	# Check whether host connectivity to the host in question exists...
	if(lc($action) eq 'ping' || lc($action) eq 'all3') {
		my ($a,$b)=query_backend($self,$host,"ECHO\n");
		if(!defined($a)) {
			return {
				error => join("\n",@$b),
			};
		}
		my $cline=$b;
		if($cline !~ /^OK\s+11223344/) {
			return {
				error => "Valid connection to '$host:$port' not possible."
			};
		}
		if(lc($action) eq 'ping') {
			return {
					error => undef
			};
		}
	}

	# Check whether the specified directory exists or not.
	if(lc($action) eq 'dir' || lc($action) eq 'all3') {
		my $d=$arg;
		if(lc($action) eq 'all3') {
			$d=dirname($arg);
		}
		my ($a,$b)=query_backend($self,$host,"CHECK_DIR DIR=$d\n");
		if(!defined($a)) {
			return {
				error => join("\n",@$b),
			};
		}
		my $cline=$b;
		if($cline =~ /^ERROR:/) {
			chomp $cline;
			$cline =~ s/^ERROR:\s+//;
			return {
				error => $cline
			};
		}
		if(lc($action) eq 'dir') {
			return {
					error => undef
			};
		}
	}

	# Check whether the specified pattern matches anything
	if(lc($action) eq 'matches' || lc($action) eq 'all3') {
		my $d=dirname($arg);
		my $f=basename($arg);
		my ($a,$b)=query_backend($self,$host,"GET_REPORT_COUNT DIR=$d NAME=$f\n");
		if(!defined($a)) {
			return {
				error => join("\n",@$b),
			};
		}
		my $cline=$b;
		if($cline =~ /^ERROR:/) {
			chomp $cline;
			$cline =~ s/^ERROR:\s+//;
			return {
				error => $cline
			};
		}
		if(lc($action) eq 'matches') {
			return {
				error => undef,
				count => int($cline)
			};
		}
		return {
			error => undef
		};
	}
}

sub get_auto_login {
my $self=shift;
	return $self->{global_config}->attempt_get_login();
}

sub allow_logout {
my $self=shift;
	return$self->{global_config}->allow_logout();
}

sub get_userprefs($$) {
my $seft=shift;
my $user=shift;

	my $prefs_obj=undef;
	my $prefs_dir=$self->{global_config}->get_directory("users");
	if(-f "$user-prefs.xml") {
		$prefs_obj=new gri_userprefs("$user-prefs.xml");
	} elsif(-f "__DEFAULT__-prefs.xml") {
		$prefs_obj=new gri_userprefs("$user-prefs.xml");
	} else {
		return {
			error => "No preferences information found.",
			prefs => {}
		};
	}
}

# Takes a G:b64enc string and if globals->gr_supported == 1
# will query the proxy service to return a list of users
# in that group. The proxy service is expected to perform
# caching for performance, not this routine.

sub using_groups {
my $self=shift;

	return $self->{global_config}->get_gr_supported()->{gr_supported};
}

sub group_matches($$) {
my $self=shift;
my $group=shift;

	my $i=$self->{global_config}->get_gr_supported();
	return(0,undef) if $i->{gr_supported}==0;
	my @h=split(/,/,$i->{gr_query_hosts});
	my $port=$i->{gr_query_port};
	if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
	my $proto = getprotobyname('tcp');
	return(undef) if ! $port;
	my $cfd;
	for my $chost (@h) {
		my $iaddr   = inet_aton($chost);
		next if !defined($iaddr);
		my $paddr   = sockaddr_in($port, $iaddr);
		socket($cfd, PF_INET, SOCK_STREAM, $proto) or next;
		connect($cfd, $paddr) or next;
		my $o=select($cfd);
		$|=1;
		select($o);
		print $cfd "GROUP_SEARCH \"$group\"\n";

		# Read the response...
		my $ANSWER="";
		{
        # Read 8 bytes to get the length to read...
			my $need=8; my $buf=""; my $bad=0;
			my $broke=0;
			while($need) {
					my $this="";
					recv($cfd,$this,$need,0);
					if(!length($this)) {
							print STDERR "Broken connection!\n";
							close($cfd);
							$broke=1; last;
					}
					$buf.=$this;
					$need-=length($this);
			}
			next if $broke;
			# $buf=length in bytes
			$need=int($buf);
			$buf="";
			while($need) {
					my $this="";
					recv($cfd,$this,$need,0);
					if(!length($this)) {
							print STDERR "Broken connection!\n";
							close($cfd);
							$broke=1; last;
					}
					$buf.=$this;
					$need-=length($this);
			}
			next if $broke;
			close($cfd);
			$ANSWER=decode_json($buf);
			if(!defined($ANSWER)) {
					return (0,"Invalid JSON response.");
			}
			if($ANSWER->{rc}==0) {
				return (1,$ANSWER->{groups});
			}
			return (0,$ANSWER->{error})
		}
	}
	return (0,"No hosts returned valid information.")
}

	# Send a GROUP_SEARCH request and await a response...
{
my	$group_cache={};

sub group_to_users($$) {
my $self=shift;
my $group=shift;

	my $i=$self->{global_config}->get_gr_supported();
	return(0,undef) if $i->{gr_supported}==0;
	$group =~ s/^G://;
	my $group2;
	$group2 = hex_to_string($group);
	return(undef) if !defined($group2);
	if(exists($group_cache->{$group2})) {
		if($group_cache->{$group2}->{ltime}+3600 > time) {
			return(1,$group_cache->{$group2}->{users});
		}
		delete($group_cache->{$group2});
	}

	my @h=split(/,/,$i->{gr_query_hosts});
	my $port=$i->{gr_query_port};
	if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
	my $proto = getprotobyname('tcp');
	return(undef) if ! $port;
	my $cfd;
	for my $chost (@h) {
		my $iaddr   = inet_aton($chost);
		next if !defined($iaddr);
		my $paddr   = sockaddr_in($port, $iaddr);
		socket($cfd, PF_INET, SOCK_STREAM, $proto) or next;
		connect($cfd, $paddr) or next;
		my $o=select($cfd);
		$|=1;
		select($o);
		print $cfd "GROUP \"$group2\"\n";

		# Read the response...
		my $ANSWER="";
		{
        # Read 8 bytes to get the length to read...
			my $need=8; my $buf=""; my $bad=0;
			my $broke=0;
			while($need) {
					my $this="";
					recv($cfd,$this,$need,0);
					if(!length($this)) {
							print STDERR "Broken connection!\n";
							close($cfd);
							$broke=1; last;
					}
					$buf.=$this;
					$need-=length($this);
			}
			next if $broke;
			# $buf=length in bytes
			$need=int($buf);
			$buf="";
			while($need) {
					my $this="";
					recv($cfd,$this,$need,0);
					if(!length($this)) {
							print STDERR "Broken connection!\n";
							close($cfd);
							$broke=1; last;
					}
					$buf.=$this;
					$need-=length($this);
			}
			next if $broke;
			close($cfd);
			$ANSWER=decode_json($buf);
			if(!defined($ANSWER)) {
					return (0,"Invalid JSON response.");
			}
			if($ANSWER->{rc}==0) {
				$group_cache->{$group2}={ltime => time, users => [@{$ANSWER->{users}}]};
				return (1,$ANSWER->{users});
			}
			return (0,$ANSWER->{error})
		}
	}
	return (0,"No hosts returned valid information.")
}

}

sub get_groups {
my $self=shift;
my $portal=shift;

	$expand=1 if !defined($expand);
	get_portal_list($self);
	if(!exists($self->{portal_names}->{$portal})) {
		print STDERR "No details for portal '$portal' found!\n";
		return(undef);
	}
	return $self->{portal_names}->{$portal}->get_groups();
}

sub set_portal_groups {
my $self=shift;
my $portal=shift;
my $groups=shift;

	get_portal_list($self);
	if(!exists($self->{portal_names}->{$portal})) {
		print STDERR "No details for portal '$portal' found!\n";
		return(0,"No details for portal '$portal' found!");
	}
	my ($a,$b)=$self->{portal_names}->{$portal}->set_groups($groups);
	if($a==0) {
		return($a,$b);
	}
	($a,$b)=$self->{portal_names}->{$portal}->write_file();
	return($a,$b);
}

sub _open_gri_database {
my $self=shift;

	return(1,undef) if defined($self->{database});
	my $db_dir=get_global_directory($self,"database");
	return(0,"Failed to find definition for 'database' directory.") if !defined($db_dir);
	my $DB=new gri_database("$db_dir/gri.db");
	if(!defined($DB)) {
		my ($ec,$es);
		($ec,$es)=gri_database::error();
		return(0,"Failed to open database: $es");
	}

	$self->{database}=$DB;
	return(1,undef);
}

sub docrepos_section_count {
my $self=shift;

	my ($rc,$err)=_open_gri_database($self);
	if($rc==0) {
		return html_error($err,0);
	}
	return $self->{database}->get_section_count();
}

sub docrepos_group_count {
my $self=shift;

	my ($rc,$err)=_open_gri_database($self);
	if($rc==0) {
		return html_error($err,0);
	}
	return $self->{database}->get_group_count();
}

# vim:syntax=on:syn=perl:tabstop=4:shiftwidth=4
1;

